Excel VBA Code to Center a Shape in a Cell

Quote of the Day

The worst pain a man can suffer is to have insight into much and power over nothing.

— Herodotus. This quote reminds me a bit of the curse of Cassandra.

Figure 1: Animated GIF Showing Operation of VBA Shape Centering Macro.

I recently finished a job where the customer wanted an Excel dashboard that displayed metrics for test case completion and various success metrics. This dashboard contained many control shapes that I wanted to be centered in cells. I do not like to manually adjust objects so I googled for a VBA routine that would center a shape. I soon found a nice piece of code by HipGecko on the Mr. Excel forum that centered pictures in the active cell. A simple modification of this code allows it to center shapes, an object type that includes pictures and controls.

Figure 1 shows an animated GIF of the macro centering a flower picture a button shape in two different cells. The code will center the object in the cell if the upper-left-hand corner of the object is in the cell. If multiple shapes are in the cell, the code will center all the shapes on top of one another.

You can download a workbook with the code here. The source is shown below.

Const inDebug As Boolean = False

Sub CenterShpIfInActiveCell()
'https://www.mrexcel.com/forum/excel-questions/222400-center-graphic-excel-cell.html
    
'If the Top-Left corner of any shape is located within the Active Cell
'Then center the shape within the Active Cell

    'Dim Shp As Picture
    Dim Shp As Shape    'Modified to handle a shape
    
    'For Each Shp In ActiveSheet.Pictures
    For Each Shp In ActiveSheet.Shapes 'Modified for a shape
    
        If inDebug Then MsgBox Shp.Name
    
        If isInBetween(ActiveCell.Left - 1, ActiveCell.Left + ActiveCell.Width, Shp.Left) And _
           isInBetween(ActiveCell.Top - 1, ActiveCell.Top + ActiveCell.Height, Shp.Top) _
           Then
                Shp.Left = ActiveCell.Left + ((ActiveCell.Width - Shp.Width) / 2)
                Shp.Top = ActiveCell.Top + ((ActiveCell.Height - Shp.Height) / 2)
        End If
        
    Next Shp
       
End Sub


Function isInBetween(lowVal As Long, _
                    hiVal As Long, targetVal As Long, _
                    Optional Inclusive As Boolean = True) As Boolean


'Return TRUE if the targetVal is between the lowVal and hiVal (Inclusive optional)


    isInBetween = False
    
    If Inclusive Then
    
        Select Case targetVal
            Case Is < lowVal
            Case Is > hiVal
            Case Else
                isInBetween = True
        End Select
        
        If inDebug Then MsgBox "Testing if " & lowVal & " <= " & targetVal & " <= " & hiVal _
        & vbCrLf & vbCrLf & "Result = " & isInBetween
        
    Else
        
        Select Case targetVal
            Case Is <= lowVal
            Case Is >= hiVal
            Case Else
                isInBetween = True
        End Select
    
        If inDebug Then MsgBox "Testing if " & lowVal & " < " & targetVal & " < " & hiVal _
        & vbCrLf & vbCrLf & "Result = " & isInBetween
        
    End If


End Function