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.
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
Thanks for this. I've been wrestling with this problem for hours and you showed me the way very clearly.
when inserting this in module the image goes to left cell automatically. how to solve this please help
Thanks, it was a problem trying to do this and your code works great.