2009-12-15 118 views
8

Tengo una imagen en la celda (3,1) y me gustaría mover la imagen a la celda (1,1).Mover imágenes entre celdas en VBA

tengo este código:

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

Sin embargo, parece que el valor de la celda está vacía para las células que contienen imágenes, por lo que, por tanto, la imagen no se mueve y la imagen en la celda (3,1) no es borrado No sucedió nada cuando corro ese bit en particular del código.

Cualquier ayuda es muy apreciada.

Gracias.

Respuesta

7

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.

3

Una manera rápida y sucia:

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 
Cuestiones relacionadas