vba Excel - 删除行时删除图像
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5991007/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel - Deleting Images when Deleting a Row
提问by David
I have a Macro that imports images from a directory and places them in excel cells that are made just big enough to fit the image in
我有一个宏，它从目录中导入图像并将它们放在 excel 单元格中，这些单元格的大小刚好足以容纳图像
A snippet of the macro is 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)
This all works fine. The images display correctly just in the cell as required. I can sort the cells successfully also and the images get moved correctly.
这一切正常。图像根据需要正确显示在单元格中。我也可以成功地对单元格进行排序，并且图像可以正确移动。
The problem I have is when I Delete an entire Row (right click on the row and delete)...in this situation the image from the row Im deleting jumps down and hides behind the image on the next row.
我遇到的问题是当我删除一整行（右键单击该行并删除）时......在这种情况下，我删除的行中的图像会跳下并隐藏在下一行的图像后面。
Is there any way that when I delete the row the image gets deleted as well?
有什么办法可以让我删除行时图像也会被删除？
回答by JMax
You can change your picture properties to "Move and size with cells". Hence, when you delete your row, your image will be deleted too. Tested in Excel 2007.
您可以将图片属性更改为“使用单元格移动和调整大小”。因此，当您删除行时，您的图像也将被删除。在 Excel 2007 中测试。
Another solution is to add a comment and fill the picture in the background (see more info here : http://www.excelforum.com/excel-general/569566-embed-image-in-cell.html)
另一种解决方案是添加评论并在背景中填充图片（在此处查看更多信息：http: //www.excelforum.com/excel-general/569566-embed-image-in-cell.html）
回答by osknows
There may be a better way but I can think of 2 workarounds.
可能有更好的方法，但我可以想到 2 个解决方法。
When you import the shape to a cell, specifically name the shape with a naming convention to identify the row/column (eg .Name = "ImageX-RowY-ColumnZ"). Then use a worksheet change event and this link Capture Deleted Rowsto cycle through the shapes and delete the required shapes based on what's been deleted.
Alternatively, fill a comment box with your image and when the row is deleted the comment & image also disappear
当您将形状导入单元格时，请使用命名约定专门命名形状以标识行/列（例如 .Name = "ImageX-RowY-ColumnZ"）。然后使用工作表更改事件和此链接捕获已删除的行来循环查看形状并根据已删除的内容删除所需的形状。
或者，用您的图像填充评论框，当行被删除时，评论和图像也会消失
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
回答by eggplant_parm
This isn't perfect, but it might meet your needs or at least get you going in the right direction.
这并不完美，但它可能会满足您的需求，或者至少可以让您朝着正确的方向前进。
Put this code in the worksheet module. When an event changes an entire row, it will delete the first shape it finds whose top left cell is in that row. This works if you're deleting a row, but it's also triggered if you cut a row, which is not desired. If you don't plan on cutting and pasting rows, than it's not an issue.
将此代码放在工作表模块中。当事件更改整行时，它将删除它找到的第一个形状，其左上角单元格在该行中。如果您要删除一行，这会起作用，但如果您剪切一行，它也会被触发，这是不希望的。如果您不打算剪切和粘贴行，那么这不是问题。
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
