Solved Help to Center an Object in a specific cell using Excel VBA

May 31, 2017 at 10:10:33
Specs: Windows 7
I need help to modify the below code to horizontally center the object (down arrow) in the specified cell (“C3”), so it is centered in column C, rather than left aligned.
I think there may be a way to do this by using an offset to the next column and then dividing by 2, to result in a centered position, but am not sure how to do so. I also need to add this same object to the adjacent cell, (“D3”), which will also need to be horizontally centered within column D. Any help would be much appreciated!

The below code inserts the object that I want and positions it within the correct cell, but has it left aligned, vs centered in that column. The width of all columns in the worksheet may change, so I can’t specify a fixed point position.

Sub AddDownArrow()

Dim CelLeft As Double
Dim CelTop As Double
Dim shp As Shape
Dim Cel As Range

Set Cel = Range("C3")
CelLeft = Cel.Left
CelTop = Cel.Top

Set shp = ActiveSheet.Shapes.AddShape(msoShapeDownArrow, CelLeft, CelTop, 38.16, 77.04)

End Sub

message edited by User444


See More: Help to Center an Object in a specific cell using Excel VBA

Report •

#1
May 31, 2017 at 12:15:12
✔ Best Answer
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Thanks!

As for your question(s), try this:

Sub AddDownArrow_v2()
Dim shp As Shape
Dim Cel As Range
'Loop through Columns 3 & 4
  For myCol = 3 To 4
   Set Cel = Cells(3, myCol)
'Insert and Center Shape
      With Cel
        Set shp = ActiveSheet.Shapes.AddShape _
                 (msoShapeDownArrow, .Left, .Top, 38.16, 77.04)
            shp.Left = .Left + ((.Width - shp.Width) / 2)
      End With
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Report •

#2
May 31, 2017 at 13:07:37
Thank you for the posting tip; and the code which works great!

One follow up question: Is there a way (without a worksheet Event) to have the 2 objects maintain their horizontal centered positions if their columns are manually resized? In other words, if they are originally centered but the columns get manually resized (after the macro has already run), is there a way for the object location to be adjusted as needed to maintain horizontal alignment relative to the new column width?


Report •

#3
May 31, 2017 at 19:06:27
re: "Is there a way (without a worksheet Event) to have the 2 objects maintain their horizontal centered positions if their columns are manually resized?"

I seriously doubt it. As far as I know, shapes are not really part of the cell, they exist in a layer above the cell layer. Other than the rather basic "Move" options available under Size and Properties, I don't think you can permanently associate the position of a shape with the cell. I think you may have to delete and reinsert the shape via Event code. I could be wrong, but that's my understanding.

As I've been known to say many times in the past, Excel is a spreadsheet application, not a document editor or a drawing app. While there are some text and shape related functions, most of the coding effort was put into the calculation tasks. The rest of the stuff is them just being nice to us. ;-)

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
June 1, 2017 at 00:17:31
Thanks for the informative details, makes total sense. The code you provided is perfect, thank you again!! :-)

Report •

#5
June 1, 2017 at 03:01:27
Hope you guys don't mind me stepping in with a suggestion?

I have slightly modified Derby's code so that the two arrows that are added, their names are captured in an array. We can use these names to reposition them. Now as there is no way to detect when a column is resized, what you can do is, probably not very efficient, but works, is to call the reposition event each time a new cell is selected, the theory being that, when you resize your column, you will no doubt select a cell at some point, after which the reposition event will move the previously added arrows.

it is not perfect but it seems to work

Dim iShape(1) As String
Dim shp As Shape
Dim Cel As Range

Sub AddDownArrow_v2()

'Loop through Columns 3 & 4
  For mycol = 3 To 4
      Set Cel = Cells(3, mycol)
'Insert and Center Shape
      With Cel
        Set shp = ActiveSheet.Shapes.AddShape _
                 (msoShapeDownArrow, .Left, .Top, 38.16, 77.04)
            shp.Left = .Left + ((.Width - shp.Width) / 2)
                    
          ' Capture the names of the two arrows added into an array
            iShape(mycol - 3) = shp.Name
      End With
  Next
End Sub

Sub RePositionShape()

    For mycol = 3 To 4
        
        Set Cel = Cells(3, mycol)
        
        With Cel
            ' set the variable shp with the names of the two arrows added
            ' and reposition them into the centre of columns 3 & 4
            
            Set shp = ActiveSheet.Shapes(iShape(mycol - 3))
            shp.Left = .Left + ((.Width - shp.Width) / 2)
        End With
    
    Next mycol
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Call the reposition event each time a new cell is selected
    RePositionShape
End Sub


Report •

#6
June 1, 2017 at 10:17:10
Hi AlwaysWillingToLearn, thanks for your follow on suggestion! I am trying to avoid using a Worksheet Event for my immediate requirement, but I do have a different use case where your code will be very helpful.

Thank you!


Report •

Ask Question