在VBA中的单元之间移动图像
我有一个单元格（3,1）的图像，并希望将图像移动到单元格（1,1）。
我有这个代码：
ActiveSheet.Cells(1, 1).Value = ActiveSheet.Cells(3, 1).Value ActiveSheet.Cells(3, 1).Value = "" 但是，对于包含图像的单元格，单元格值似乎为空，因此图像不会移动，单元格（3,1）中的图像不会被删除。 当我运行代码的特定位时什么都没有发生。
任何帮助是极大的赞赏。
谢谢。
你的代码的一部分问题是，你正在想像图像作为单元格的值 。 但是，虽然图像可能看起来像“在”单元格中，但实际上并不是单元格的值。
要移动图像，可以这样做（使用Shape.IncrementLeft或Shape.IncrementRight ），或者你可以绝对做到这一点（通过设置Shape.Left和Shape.Top的值）。
在下面的例子中，我演示了如何将形状移动到一个新的绝对位置，保持原始单元格的原始缩进不变（如果不保留原始缩进，这与设置“ Top和“ Left Shape值等于目标Range ）。
这个过程需要一个形状名称（你可以通过很多方法find形状名称;我做的方法是logging一个macros，然后单击形状并移动它以查看它生成的代码），目标地址（如"A1" ）和（可选）布尔值，指示是否要保留原始缩进偏移量。
Sub ShapeMove(strShapeName As String, _ strTargetAddress As String, _ Optional blnIndent As Boolean = True) Dim ws As Worksheet Dim shp As Shape Dim dblCurrentPosLeft As Double Dim dblCurrentPosTop As Double Dim rngCurrentCell As Range Dim dblCurrentCellTop As Double Dim dblCurrentCellLeft As Double Dim dblIndentLeft As Double Dim dblIndentTop As Double Dim rngTargetCell As Range Dim dblTargetCellTop As Double Dim dblTargetCellLeft As Double Dim dblNewPosTop As Double Dim dblNewPosLeft As Double 'Set ws to be the ActiveSheet, though this can really be any sheet ' Set ws = ActiveSheet 'Set the shp variable as the shape with the specified shape name ' Set shp = ws.Shapes(strShapeName) 'Get the current position of the image on the worksheet ' dblCurrentPosLeft = shp.Left dblCurrentPosTop = shp.Top 'Get the current cell range of the image ' Set rngCurrentCell = ws.Range(shp.TopLeftCell.Address) 'Get the absolute position of the current cell ' dblCurrentCellLeft = rngCurrentCell.Left dblCurrentCellTop = rngCurrentCell.Top 'Establish the current offset of the image in relation to the top left cell' dblIndentLeft = dblCurrentPosLeft - dblCurrentCellLeft dblIndentTop = dblCurrentPosTop - dblCurrentCellTop 'Set the rngTargetCell object to be the address specified in the paramater ' Set rngTargetCell = ws.Range(strTargetAddress) 'Get the absolute position of the target cell ' dblTargetCellLeft = rngTargetCell.Left dblTargetCellTop = rngTargetCell.Top 'Establish the coordinates of the new position. Only indent if the boolean ' ' parameter passed in is true. ' ' NB: The indent can get off if your indentation is greater than the length ' ' or width of the cell ' If blnIndent Then dblNewPosLeft = dblTargetCellLeft + dblIndentLeft dblNewPosTop = dblTargetCellTop + dblIndentTop Else dblNewPosLeft = dblTargetCellLeft dblNewPosTop = dblTargetCellTop End If 'Move the shape to its new position ' shp.Top = dblNewPosTop shp.Left = dblNewPosLeft End Sub
注：我以非常function的方式编写代码。 如果你想“清理”这个代码，最好把这个function放在一个对象中。 希望它能帮助读者了解Excel中的形状如何在Excel中工作。
一个快速和肮脏的方式：
Public Sub Example() MoveShape ActiveSheet.Shapes("Picture 1"), Range("A1") End Sub Private Sub MoveShape(ByVal shp As Excel.Shape, ByVal target As Excel.Range) shp.IncrementLeft -(shp.TopLeftCell.Left - target.Left) shp.IncrementTop -(shp.TopLeftCell.Top - target.Top) End Sub