在VBA中單元格之間移動圖像

我在單元格（3,1）中有一個圖像，並且想要將圖像移動到單元格（1,1）中。在VBA中單元格之間移動圖像

我有這樣的代碼：

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

然而，似乎是，單元格的值是空的用於包含圖像的細胞，所以因此圖像不移動並在細胞圖像（3,1）是不刪除。當我運行代碼的特定位時什麼都沒有發生。

任何幫助，非常感謝。

謝謝。

來源

2009-12-15 Tim

與您的代碼的問題的一部分是，您正在考慮該圖像作爲單元格的值。但是，雖然圖像可能看起來像「在」單元格中，但它實際上並不是單元格的值。

移動圖像，你可以這樣做相對（使用Shape.IncrementLeft或Shape.IncrementRight），或者你可以（通過設置Shape.Left和Shape.Top值）做絕對。

在下面的示例中，我演示瞭如何將形狀移動到新的絕對位置，同時保留原始單元格的原始縮進（如果不保留原始縮進，這與設置一樣簡單Shape的Top和Left值等於目標Range的值）。

此過程需要一個形狀名稱（您可以通過多種方式找到形狀名稱;我所做的方式是錄製一個宏，然後單擊該形狀並將其移動以查看其生成的代碼），目標地址（如"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

注：我寫的代碼在很大程度上是一個功能性的方式。如果你想要「清理」這個代碼，最好是把這個功能放在一個對象中，希望它能幫助讀者理解Excel中的形狀是如何工作的

來源

2009-12-15 14:30:09

一個快速和骯髒的方式：

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

來源

2009-12-15 15:16:28 Oorang

在VBA中單元格之間移動圖像

回答

相關問題