在 VBA 中的单元格之间移动图像

Moving images between cells in VBA

提问by Tim

I have an image in cell (3,1) and would like to move the image into cell (1,1).

我在单元格 (3,1) 中有一个图像，并且想将图像移动到单元格 (1,1) 中。

I have this code:

我有这个代码：

ActiveSheet.Cells(1, 1).Value = ActiveSheet.Cells(3, 1).Value
ActiveSheet.Cells(3, 1).Value = ""

However, it seems that the cell value is empty for cells containing images, so therefore the image is not moved and the image in cell (3,1) is not deleted. Nothing happened when I run that particular bit of the code.

但是，对于包含图像的单元格，单元格值似乎为空，因此不会移动图像并且不会删除单元格 (3,1) 中的图像。当我运行那段代码时什么也没发生。

Any help is greatly appreciated.

任何帮助是极大的赞赏。

Thanks.

谢谢。

回答by Ben McCormack

Part of the problem with your code is that you are thinking of the image as the valueof the cell. However, although the image might appear to be "in" the cell, it is not actually the value of the cell.

您的代码的部分问题在于您将图像视为单元格的值。然而，尽管图像可能看起来“在”单元格中，但它实际上并不是单元格的值。

To move the image, you can do so relatively(using Shape.IncrementLeftor Shape.IncrementRight) or you can do it absolutely(by setting the values of Shape.Leftand Shape.Top).

移动图像，你可以这样做比较（使用Shape.IncrementLeft或Shape.IncrementRight），或者你可以做到这一点绝对（通过设置的值Shape.Left和Shape.Top）。

In the example below, I demonstrate how you can move the shape to a new absolute position with or without keeping the original indentation off of the original cell (if you are not keeping the original indentation, this is as simple as setting the Topand Leftvalues of the Shapeto be equal to those of the target Range).

在下面的例子中，我演示如何将形状移动到新的绝对位置，有或没有保持原有对开压痕的原始细胞（如果你没有保持原有的缩进，这很简单，只要设置Top和Left值在Shape等于与目标的Range）。

This procedure takes in a shape name (you can find the shape name in a number of ways; the way I did it was to record a macro and then click on the shape and move it to see the code it generated), the target address (such as "A1", and (optionally) a boolean value indicating if you want to retain the original indentation offset.

这个过程需要一个形状名称（你可以通过多种方式找到形状名称；我这样做的方法是录制一个宏然后点击形状并移动它以查看它生成的代码），目标地址（例如"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

NOTE: I wrote the code in very much a functional manner. If you wanted to "clean up" this code, it would be best to put the functionality within an object. Hopefully it helps the reader understand how shapes work in Excel either way.

注意：我以非常实用的方式编写了代码。如果您想“清理”此代码，最好将功能放在一个对象中。希望它可以帮助读者了解形状在 Excel 中的工作方式。

回答by Oorang

A quick and dirty way:

一种快速而肮脏的方式：

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