Moving images between cells in VBA Moving images between cells in VBA vba vba

Moving images between cells in VBA


Part of the problem with your code is that you are thinking of the image as the value of 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.IncrementLeft or Shape.IncrementRight) or you can do it absolutely (by setting the values of Shape.Left and 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 Top and Left values of the Shape to be equal to those of the target 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.

Sub ShapeMove(strShapeName As String, _    strTargetAddress As String, _    Optional blnIndent As Boolean = True)Dim ws As WorksheetDim shp As ShapeDim dblCurrentPosLeft As DoubleDim dblCurrentPosTop As DoubleDim rngCurrentCell As RangeDim dblCurrentCellTop As DoubleDim dblCurrentCellLeft As DoubleDim dblIndentLeft As DoubleDim dblIndentTop As DoubleDim rngTargetCell As RangeDim dblTargetCellTop As DoubleDim dblTargetCellLeft As DoubleDim dblNewPosTop As DoubleDim 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.LeftdblCurrentPosTop = 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.LeftdblCurrentCellTop = rngCurrentCell.Top'Establish the current offset of the image in relation to the top left cell'dblIndentLeft = dblCurrentPosLeft - dblCurrentCellLeftdblIndentTop = 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.LeftdblTargetCellTop = 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 + dblIndentTopElse    dblNewPosLeft = dblTargetCellLeft    dblNewPosTop = dblTargetCellTopEnd If'Move the shape to its new position 'shp.Top = dblNewPosTopshp.Left = dblNewPosLeftEnd 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.


A quick and dirty way:

Public Sub Example()    MoveShape ActiveSheet.Shapes("Picture 1"), Range("A1")End SubPrivate 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