以下子代码枚举了活动工作表的形状集合的有趣属性,但在包含时不会编译Case msoIgxGraphic
。 虽然我发誓它今天早些时候确实编译了。 我正在使用 Excel 2007。为 Office 2007 定义的 msoShapeType 枚举清楚地包含该值。
我检查并再次检查拼写错误 - 找不到。
我只将一个子添加到新创建的,否则为空的工作簿中的模块中。仍然不会编译。错误信息是:
'Compile Error: Variable not Defined'
并msoIgxGraphic
突出显示。从 select 语句中注释掉该节,它会编译并运行,没问题。我错过了什么?
Option Explicit
Sub GetShapeProperties()
Dim sShapes As Shape, lLoop As Long
Dim wsStart As Worksheet, WsNew As Worksheet
Dim obj As OLEObject
Dim obType As String
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''LIST PROPERTIES OF SHAPES'''''''''''''
''''''''''Dave Hawley www.ozgrid.com''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set wsStart = ActiveSheet
Set WsNew = Sheets.Add
If Len("Shapes Info") <> 0 Then
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Shapes Info").Delete
On Error GoTo 0
Application.DisplayAlerts = True
WsNew.Name = "Shapes Info"
End If
'Add headings for our lists. Expand as needed
WsNew.Range("A1:X1") = _
Array("Shape Name", ".OLEFormat.Object.Name", "Height", "Width", "Left", "Top" _
, "AlternativeText" _
, "Id" _
, "Type" _
, "Shape Type" _
, "OLEFormat.Object.index" _
, "OLEFormat.Object.Left" _
, "OLEFormat.Object.Width" _
, "OLEFormat.Object.Top" _
, "OLEFormat.Object.Height" _
, "OLEFormat.Object.TopLeftCell.Address" _
, "OLEFormat.Object.BottomRightCell.Address" _
, "OLEFormat.Object.ZOrder" _
, "OLEFormat.Object.Locked" _
, "OLEFormat.Object.Visible" _
, "OnAction" _
, "VerticalFlip" _
, "ZOrderPosition")
'Loop through all shapes on active sheet
For Each sShapes In wsStart.Shapes
'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes
'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .Name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.Name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
'Follow the same pattern for more
WsNew.Cells(lLoop + 1, 7) = .AlternativeText
WsNew.Cells(lLoop + 1, 8) = .ID
WsNew.Cells(lLoop + 1, 9) = .Type
Select Case .Type
Case msoAutoShape
obType = "AutoShape"
Case msoCallout
obType = "Callout"
Case msoCanvas
obType = "Canvas"
Case msoChart
obType = "Chart"
Case msoComment
obType = "Comment"
Case msoDiagram
obType = "Diagram"
Case msoEmbeddedOLEObject
obType = "EmbeddedOLEObject"
Case msoFormControl
Select Case .FormsControlType
Case xlButtonControl
obType = "FormsControlType Button"
Case xlCheckBox
obType = "FormsControlType CheckBox"
Case xlDropDown
obType = "FormsControlType DropDown"
Case xlEditBox
obType = "FormsControlType EditBox"
Case xlGroupBox
obType = "FormsControlType GroupBox"
Case xlLabel
obType = "FormsControlType Label"
Case xlListBox
obType = "FormsControlType ListBox"
Case xlOptionButton
obType = "FormsControlType OptionButton"
Case xlScrollBar
obType = "FormsControlType ScrollBar"
Case xlSpinner
obType = "FormsControlType Spinner"
Case Else
obType = "Unknown MsoFormsControlType"
End Select
Case msoFreeform
obType = "Freeform"
Case msoGroup
obType = "Group"
Case msoIgxGraphic
obType = "IgxGraphic"
Case msoInk
obType = "Ink"
Case msoInkComment
obType = "InkComment"
Case msoLine
obType = "Line"
Case msoLinkedOLEObject
obType = "LinkedOLEObject"
Case msoLinkedPicture
obType = "LinkedPicture"
Case msoMedia
obType = "Media"
Case msoOLEControlObject
Set obj = .OLEFormat.Object
obType = "OLEControlObject " + "(" + obj.Application.Name + "): " + TypeName(obj.Object)
Case msoPicture
obType = "Picture"
Case msoPlaceholder
obType = "Placeholder"
Case msoScriptAnchor
obType = "ScriptAnchor"
Case msoShapeTypeMixed
obType = "ShapeTypeMixed"
Case msoTable
obType = "Table"
Case msoTextBox
obType = "TextBox"
Case msoTextEffect
obType = "TextEffect"
Case Else
obType = "Unknown MsoShapeType"
End Select
WsNew.Cells(lLoop + 1, 10) = obType
WsNew.Cells(lLoop + 1, 12) = .OLEFormat.Object.Index
WsNew.Cells(lLoop + 1, 13) = .OLEFormat.Object.Left
WsNew.Cells(lLoop + 1, 14) = .OLEFormat.Object.Width
WsNew.Cells(lLoop + 1, 15) = .OLEFormat.Object.Top
WsNew.Cells(lLoop + 1, 16) = .OLEFormat.Object.Height
WsNew.Cells(lLoop + 1, 17) = .OLEFormat.Object.TopLeftCell.Address
WsNew.Cells(lLoop + 1, 18) = .OLEFormat.Object.BottomRightCell.Address
WsNew.Cells(lLoop + 1, 19) = .OLEFormat.Object.ZOrder
WsNew.Cells(lLoop + 1, 20) = .OLEFormat.Object.Locked
WsNew.Cells(lLoop + 1, 21) = .OLEFormat.Object.Visible
WsNew.Cells(lLoop + 1, 22) = .OnAction
WsNew.Cells(lLoop + 1, 24) = .VerticalFlip
WsNew.Cells(lLoop + 1, 25) = .ZOrderPosition
End With
Next sShapes
WsNew.Columns.AutoFit
End Sub