none
Finding Shape Type and Shape Location in VBA RRS feed

  • Question

  • I have the the following VBA Code on a worksheet with a single Shape drawn on it.

    Private Sub ShapeInfo()

    ActiveSheet.Shapes(1).Select

    MsgBox (Selection.Text)
    MsgBox (Selection.Width)
    MsgBox (Selection.Height)
    MsgBox (Selection.ShapeRange.Fill.Visible)
    MsgBox (Selection.ShapeRange.Fill.ForeColor.RGB)
    MsgBox (Selection.ShapeRange.Fill.Transparency)
    MsgBox (Selection.ShapeRange.Line.Visible)
    MsgBox (Selection.ShapeRange.Type)
    MsgBox (Selection.ShapeRange.Location)



    End Sub

    This extracts information about the shape. But the last 2 lines give me either garbage information or an error message. How I extract the Shape Type (Circle, Square, ect.) And the X,Y position of the shape?

    Monday, November 20, 2017 6:03 PM

Answers

  • Jonmark,
    re: what shape

    You can get a generic description and the distance (72 points/inch) from the top left corner of the sheet with...
    Sub TellMeAboutYourself()
    Dim x
    Dim y
    Dim z
    With ActiveSheet.Shapes(1)
      x = .Name
      y = .Top
      z = .Left
    End With
    MsgBox x & vbCr & "top is " & y & vbCr & "left is " & z
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2  (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by Jonmark Henry Monday, November 20, 2017 7:13 PM
    Monday, November 20, 2017 6:44 PM
  • For example:

    Private Sub ShapeInfo()
        Dim shp As Shape
        Dim strText As String
        Set shp = ActiveSheet.Shapes(1)
        With shp
            strText = "Name: " & .Name & vbCrLf & _
                "Text: " & .TextFrame.Characters.Text & vbCrLf & _
                "Left: " & .Left & vbCrLf & _
                "Top: " & .Top & vbCrLf & _
                "Width: " & .Width & vbCrLf & _
                "Height: " & .Height & vbCrLf & _
                "Visible: " & IIf(.Fill.Visible, "True", "False") & vbCrLf & _
                "Fore Color: " & .Fill.ForeColor.RGB & vbCrLf & _
                "Transparency: " & Format(.Fill.Transparency, "0%") & vbCrLf & _
                "Border visible: " & IIf(.Line.Visible, "True", "False") & vbCrLf & _
                "Type: " & GetType(.Type)
            If .Type = msoAutoShape Then
                strText = strText & " (" & GetAutoShapeType(.AutoShapeType) & ")"
            End If
        End With
        MsgBox strText, vbInformation
    End Sub

    Function GetType(shpType As MsoShapeType) As String
        Select Case shpType
            Case 1
                GetType = "AutoShape"
            Case 2
                GetType = "Callout"
            Case 3
                GetType = "Chart"
            Case 4
                GetType = "Comment"
            Case 5
                GetType = "FreeForm"
            Case 6
                GetType = "Group"
            Case 7
                GetType = "Embedded OLE Object"
            Case 8
                GetType = "Form Control"
            Case 9
                GetType = "Line"
            Case 10
                GetType = "Linked OLE Object"
            Case 11
                GetType = "Linked Picture"
            Case 12
                GetType = "OLE Control"
            Case 13
                GetType = "Picture"
            Case Else
                GetType = "Other"
        End Select
    End Function

    Function GetAutoShapeType(shpType As MsoAutoShapeType) As String
        Select Case shpType
            Case 1
                GetAutoShapeType = "Rectangle"
            Case 2
                GetAutoShapeType = "Parallelogram"
            Case 3
                GetAutoShapeType = "Trapezoid"
            Case 4
                GetAutoShapeType = "Diamond"
            Case 5
                GetAutoShapeType = "Rounded Rectangle"
            Case 6
                GetAutoShapeType = "Octagon"
            Case 7
                GetAutoShapeType = "Isosceles Triangle"
            Case 8
                GetAutoShapeType = "Right Triangle"
            Case 9
                GetAutoShapeType = "Oval"
            Case 10
                GetAutoShapeType = "Hexagon"
            Case 11
                GetAutoShapeType = "Cross"
            Case 12
                GetAutoShapeType = "Regular Pentagon"
            Case 13
                GetAutoShapeType = "Can"
            Case Else
                GetAutoShapeType = "Other"
        End Select
    End Function

    You can expand the two functions - look up msoShapeType and msoAutoShapeType.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Jonmark Henry Monday, November 20, 2017 7:13 PM
    Monday, November 20, 2017 6:58 PM

All replies

  • Jonmark,
    re: what shape

    You can get a generic description and the distance (72 points/inch) from the top left corner of the sheet with...
    Sub TellMeAboutYourself()
    Dim x
    Dim y
    Dim z
    With ActiveSheet.Shapes(1)
      x = .Name
      y = .Top
      z = .Left
    End With
    MsgBox x & vbCr & "top is " & y & vbCr & "left is " & z
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2  (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by Jonmark Henry Monday, November 20, 2017 7:13 PM
    Monday, November 20, 2017 6:44 PM
  • For example:

    Private Sub ShapeInfo()
        Dim shp As Shape
        Dim strText As String
        Set shp = ActiveSheet.Shapes(1)
        With shp
            strText = "Name: " & .Name & vbCrLf & _
                "Text: " & .TextFrame.Characters.Text & vbCrLf & _
                "Left: " & .Left & vbCrLf & _
                "Top: " & .Top & vbCrLf & _
                "Width: " & .Width & vbCrLf & _
                "Height: " & .Height & vbCrLf & _
                "Visible: " & IIf(.Fill.Visible, "True", "False") & vbCrLf & _
                "Fore Color: " & .Fill.ForeColor.RGB & vbCrLf & _
                "Transparency: " & Format(.Fill.Transparency, "0%") & vbCrLf & _
                "Border visible: " & IIf(.Line.Visible, "True", "False") & vbCrLf & _
                "Type: " & GetType(.Type)
            If .Type = msoAutoShape Then
                strText = strText & " (" & GetAutoShapeType(.AutoShapeType) & ")"
            End If
        End With
        MsgBox strText, vbInformation
    End Sub

    Function GetType(shpType As MsoShapeType) As String
        Select Case shpType
            Case 1
                GetType = "AutoShape"
            Case 2
                GetType = "Callout"
            Case 3
                GetType = "Chart"
            Case 4
                GetType = "Comment"
            Case 5
                GetType = "FreeForm"
            Case 6
                GetType = "Group"
            Case 7
                GetType = "Embedded OLE Object"
            Case 8
                GetType = "Form Control"
            Case 9
                GetType = "Line"
            Case 10
                GetType = "Linked OLE Object"
            Case 11
                GetType = "Linked Picture"
            Case 12
                GetType = "OLE Control"
            Case 13
                GetType = "Picture"
            Case Else
                GetType = "Other"
        End Select
    End Function

    Function GetAutoShapeType(shpType As MsoAutoShapeType) As String
        Select Case shpType
            Case 1
                GetAutoShapeType = "Rectangle"
            Case 2
                GetAutoShapeType = "Parallelogram"
            Case 3
                GetAutoShapeType = "Trapezoid"
            Case 4
                GetAutoShapeType = "Diamond"
            Case 5
                GetAutoShapeType = "Rounded Rectangle"
            Case 6
                GetAutoShapeType = "Octagon"
            Case 7
                GetAutoShapeType = "Isosceles Triangle"
            Case 8
                GetAutoShapeType = "Right Triangle"
            Case 9
                GetAutoShapeType = "Oval"
            Case 10
                GetAutoShapeType = "Hexagon"
            Case 11
                GetAutoShapeType = "Cross"
            Case 12
                GetAutoShapeType = "Regular Pentagon"
            Case 13
                GetAutoShapeType = "Can"
            Case Else
                GetAutoShapeType = "Other"
        End Select
    End Function

    You can expand the two functions - look up msoShapeType and msoAutoShapeType.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Jonmark Henry Monday, November 20, 2017 7:13 PM
    Monday, November 20, 2017 6:58 PM
  • Thank you very much. This is exactly what I needed.
    Monday, November 20, 2017 7:13 PM
  • Thank you very much. This is exactly what I needed.
    Monday, November 20, 2017 7:13 PM