Geek asks and answers

Excel - Deleting images when deleting a row

I have a macro that imports images from a directory and puts them in excel cells that are made large enough to fit the image in

The macro fragment is shown below: -

'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)

It all works great. Images are displayed correctly in the cell as needed. I can sort the cells successfully and the images move correctly.

The problem is when I delete the entire row of rows (right-click on the row and delete) ... in this situation, the image from the Im line that is deleted is discarded and hides behind the image in the next row.

Is there a way to delete an image when deleting a row?

+3
source share
3 answers

, , 2 .

Eg

 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
+3

, , , .

Put this code on the worksheet. When an event changes an entire row, it deletes the first figure found, whose upper left cell is in that row. This works if you delete the line, but it also works if you cut the line, which is undesirable. If you do not plan to cut and paste lines, this is not a problem.

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
+1
source

More articles:


All Articles