Parte del problema con el código es que está pensando en la imagen como valor de la celda. Sin embargo, aunque la imagen parezca estar "en" la celda, en realidad no es el valor de la celda.
Para mover la imagen, puede hacerlo relativamente (usando Shape.IncrementLeft
o Shape.IncrementRight
) o puede hacerlo absolutamente (mediante el establecimiento de los valores de Shape.Left
y Shape.Top
).
En el siguiente ejemplo, demuestro cómo puede mover la forma a una nueva posición absoluta con o sin mantener la indentación original fuera de la celda original (si no conserva la sangría original, esto es tan simple como establecer los valores Top
y Left
del Shape
para que sean iguales a los del objetivo Range
).
Este procedimiento tiene un nombre de forma (puede encontrar el nombre de la forma de varias maneras; la forma en que lo hice fue grabar una macro y luego hacer clic en la forma y moverla para ver el código generado) , la dirección de destino (como "A1"
, y (opcionalmente) un valor booleano que indica si desea conservar el desplazamiento muesca originales
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
NOTA:.. escribí el código en gran medida una manera funcional Si quería "limpiar" este código, sería mejor poner la funcionalidad dentro de un objeto. Afortunadamente, ayuda al lector a comprender cómo funcionan las formas en Excel de cualquier manera.