(Solved) – Trouble Sizing and Positioning Shapes in Excel VBA

  • by
(solved)-–-trouble-sizing-and-positioning-shapes-in-excel-vba

I have several macros that build up a spreadsheet, then delete it when I’m done with it.
As the spreadsheet is being built, I wanted a quick way to add buttons and assign them macros.
So, I built the below sub.

Here is my problem: The below Sub works fine, except that the Shape acts weird when I adjust it’s size.
I’m able to position it where I want, but when I change the width and height, the button behaves erratically. I’ve spent a few hours on this, but at this point I’m stumped! Any help would be greatly appreciated.

Public Sub ButtonCreation(AssignMacroName As String, NameIt As String, _ NameLength As String, FontSize As String, posX As String, posY As String, _
width As String, height As String, OneBlueTwoOrangeThreeEtc As _
Integer, FontColorSeeCode As Integer)

ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, posX, posY, width, height).Select

Selection.OnAction = AssignMacroName

'I can add more colors.  Just assign each one a numerical value.
If OneBlueTwoOrangeThreeEtc = 1 Then
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192)
        .Transparency = 0
        .Solid
    End With
    ElseIf OneBlueTwoOrangeThreeEtc = 2 Then
        With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(197, 90, 17)
        .Transparency = 0
        .Solid
    End With
    ElseIf OneBlueTwoOrangeThreeEtc = 3 Then
        With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(209, 213, 211)
        .Transparency = 0
        .Solid
    End With
End If

Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = NameIt
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, NameLength). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, NameLength).Font
        .NameComplexScript = " mn-cs"
        .NameFarEast = " mn-ea"
        .Fill.Visible = msoTrue
        '.Fill.ForeColor.RGB = RGB(0, 0, 0)   Commented out; I'm choosing colors below.
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = FontSize
        .Name = " mn-lt"
    End With

'Add as many Elseif as needed; I have the 3rd one ready to uncomment and use.
If FontColorSeeCode = 1 Then
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, NameLength).Font
    .Fill.ForeColor.RGB = RGB(0, 0, 0)
    End With

ElseIf FontColorSeeCode = 2 Then
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, NameLength).Font
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    End With

'Elseif FontColorSeeCode = 3 Then
'    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, NameLength).Font
'    .Fill.ForeColor.RGB = RGB(0, 0, 0)
'    End With

End If


End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *