Excel - удаление изображений при удалении строки - PullRequest
3 голосов
/ 13 мая 2011

У меня есть макрос, который импортирует изображения из каталога и помещает их в ячейки Excel, которые сделаны достаточно большими, чтобы поместиться в изображение в

Ниже приведен фрагмент макроса: -

'Set the Row Height and Column Width of the thumbnail

Range("A" & CStr(currRow)).RowHeight = ThumbnailSizeRef + 2 

Columns("A").ColumnWidth = (ThumbnailSizeRef - 5) / 5 'Column Width uses a font width setting, this is the formula to convert to pixels

'Add the thumbnail
Set sShape = ActiveSheet.Shapes.AddPicture(Filename:=sFilename, LinktoFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=ThumbnailSizeRef, Height:=ThumbnailSizeRef)

'Set the Left and Top position of the Shape
sShape.Left = Range("A" & CStr(currRow)).Left + ((Range("A" & CStr(currRow)).Width - sShape.Width) / 2)

sShape.Top = Range("A" & CStr(currRow)).Top + ((Range("A" & CStr(currRow)).Height - sShape.Height) / 2)

Это все отлично работает.Изображения отображаются правильно только в ячейке, как требуется.Я могу также успешно отсортировать ячейки, и изображения будут перемещены правильно.

Проблема, с которой я столкнулся, заключается в том, чтобы удалить всю строку (щелкнуть правой кнопкой мыши по строке и удалить) ... в этой ситуации изображение изстрока, которую я удаляю, прыгает вниз и прячется за изображением в следующей строке.

Есть ли способ, что при удалении строки изображение также удаляется?

Ответы [ 3 ]

5 голосов
/ 13 мая 2011

Вы можете изменить свойства изображения на «Перемещение и размер с ячейками».Следовательно, когда вы удаляете свою строку, ваше изображение будет также удалено.Протестировано в Excel 2007.

Другим решением является добавление комментария и заливка картинки на заднем плане (см. Дополнительную информацию здесь: http://www.excelforum.com/excel-general/569566-embed-image-in-cell.html)

3 голосов
/ 13 мая 2011

Возможно, есть лучший способ, но я могу придумать 2 обходных пути.

  1. Когда вы импортируете фигуру в ячейку, определите имя фигуры с соглашением об именах, чтобы идентифицировать строку / столбец (например, .Name = "ImageX-RowY-ColumnZ").Затем используйте событие изменения рабочего листа и эту ссылку Захватить удаленные строки для циклического перемещения по фигурам и удаления необходимых фигур на основе того, что было удалено.

  2. В качестве альтернативы, заполнитеполе для комментариев с вашим изображением, и когда строка удаляется, комментарий и изображение также исчезают

Например:

 Sub test()
 ThumbnailSizeRef = 100
 currRow = 5
 sFilename = "C:\Users\....\Desktop\Untitled.png"

 Range("A" & CStr(currRow)).RowHeight = ThumbnailSizeRef + 2

 Columns("A").ColumnWidth = (ThumbnailSizeRef - 5) / 5

 With Sheet1
    With .Range("A" & currRow)
        .ClearComments
        .AddComment

        With .Comment
        .Visible = True
        .Text Text:=""
        .Shape.Left = Sheet1.Range("A" & currRow).Left
        .Shape.Top = Sheet1.Range("A" & currRow).Top
        .Shape.Width = Sheet1.Range("A" & currRow).Offset(0, 1).Left - Sheet1.Range("A" & currRow).Left
        .Shape.Height = Sheet1.Range("A" & currRow).Offset(1, 0).Top - Sheet1.Range("A" & currRow).Top
        .Shape.Fill.UserPicture sFilename
        .Shape.Line.ForeColor.RGB = RGB(255, 255, 255) 'hides connector arrow

        End With

    End With
End With

End Sub
1 голос
/ 13 мая 2011

Это не идеально, но может удовлетворить ваши потребности или, по крайней мере, заставить вас двигаться в правильном направлении.

Поместите этот код в модуль рабочего листа.Когда событие изменяет всю строку, оно удаляет первую найденную фигуру, чья верхняя левая ячейка находится в этой строке.Это работает, если вы удаляете строку, но также срабатывает и при вырезании строки, что нежелательно.Если вы не планируете вырезать и вставлять строки, это не проблема.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pic As Shape
    If Union(Target, Target.EntireRow).Address = Target.Address Then
        For Each pic In ActiveSheet.Shapes
            If pic.TopLeftCell.Row = Target.Row Then
                pic.Delete
                Exit For
            End If
        Next pic
    End If
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...