アクティブなワークシートの形状コレクションの興味深いプロパティを列挙する次のサブルーチンは、含まれているとコンパイルされませんCase msoIgxGraphic。 私はそれが今日早くコンパイルされたことを誓いますが。 Excel 2007 を使用しています。Office 2007 用に定義された msoShapeType 列挙には、明らかに値が含まれています。
スペルミスがないか確認して再確認しましたが、見つかりません。
新しく作成された、それ以外の場合は空のワークブックのモジュールにサブを 1 つだけ追加しました。それでもコンパイルされません。エラーメッセージは次のとおりです。
'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