VBA – Excel – Routine to position shapes in range

Routine to position shapes in worksheet based on specified ranges.

Note: Can use ‘print shape name‘ routine to create required list. See snippet below.

Sub RunPlaceShapeInRange()
    'Routine to place specified shape in specified range
    Dim CWS As Worksheet
    
    Set CWS = ChartSht 'Change this to specific worksheet object
     
    'Uncomment line below to specify worksheet name
    'Set CWS = ThisWorkbook.Worksheets("WorksheetName")
    
    Call PlaceShapeInRange("Shape No1", "D2:G4", CWS)
End Sub

Sub PlaceShapeInRange(ShapeName As String, RangeStr As String, InWS As Worksheet)
    'Routine to place specified shape in specified range. Run from: RunPlaceShapeInRange
    
    Dim CShape As Shape
    Dim CRange As Range
    
    Set CShape = InWS.Shapes(ShapeName)
    Set CRange = InWS.Range(RangeStr)
    
    CShape.Left = CRange.Left
    CShape.Top = CRange.Top
    CShape.Width = CRange.Width
    CShape.Height = CRange.Height
    
End Sub

To position a lot of shapes (which is the main point of this routine), a list can be quickly generated using the ‘print shape names‘ routine and inserting something like:

Debug.Print "Call PlaceShapeInRange(" & Chr(34) & CShape.Name & Chr(34) & ", " & Chr(34) & "Range" & Chr(34) & ", CWS)"

in the appropriate position. This will produce something like:

Call PlaceShapeInRange(“SalesChart”, “Range”, CWS)
Call PlaceShapeInRange(“Salesman”, “Range”, CWS)
Call PlaceShapeInRange(“Current (Y/N)”, “Range”, CWS)

Which then requires the specified range to be typed in.

Example:

Sub RunPlaceShapeInRange()
    'Routine to place specified shape in specified range
    Dim CWS As Worksheet
    
    Set CWS = ChartSht 'Change this to specific worksheet object
     
    'Uncomment line below to specify worksheet name
    'Set CWS = ThisWorkbook.Worksheets("WorksheetName")
    
    Call PlaceShapeInRange("SalesChart", "I6:V38", CWS)
    Call PlaceShapeInRange("Salesman", "F6:G25", CWS)
    Call PlaceShapeInRange("Current (Y/N)", "F40:G44", CWS)
    Call PlaceShapeInRange("Year", "I2:P4", CWS)
    Call PlaceShapeInRange("Acc size", "X2:AF4", CWS)
   
End Sub