Option Explicit
Private Sub cmdExecSearch_Click()
On Error GoTo Err_cmdExecSearch
Dim shp As Shape
Dim intRow As Integer
Dim strText As String
Dim strTypeName As String
Dim intIndx As Integer
Dim intRowCount As Integer
Dim aryShapes() As Variant
Dim strShape As String
Dim i As Integer
Dim j As Integer
Dim swap As String
Dim aryShapeItems() As String
With ActiveSheet
.Range("A:G").Clear
intRow = 1
.Cells(intRow, 1).Value = "Index"
.Cells(intRow, 2).Value = "Top"
.Cells(intRow, 3).Value = "Left"
.Cells(intRow, 4).Value = "Name"
.Cells(intRow, 5).Value = "Text"
.Cells(intRow, 6).Value = "Type"
intIndx = 0
For Each shp In .Shapes
intRow = intRow + 1
intIndx = intIndx + 1
.Cells(intRow, 1).Value = intIndx
.Cells(intRow, 2).Value = shp.Top
.Cells(intRow, 3).Value = shp.Left
.Cells(intRow, 4).Value = shp.Name
strText = "-"
If shp.Type <> msoGroup Then
If shp.TextFrame2.HasText Then
strText = shp.TextFrame2.TextRange.Text
End If
End If
.Cells(intRow, 5).Value = strText
strTypeName = fnGetTypeName(shp)
.Cells(intRow, 6).Value = strTypeName
strShape = Format(shp.Top * 1000, "00000000") & Format(shp.Left, "00000") & Chr(9) & _
shp.Name & Chr(9) & strText & Chr(9) & strTypeName & Chr(9) & CStr(intIndx)
ReDim Preserve aryShapes(intIndx - 1)
aryShapes(intIndx - 1) = strShape
Next
intRowCount = intRow
For i = LBound(aryShapes) To UBound(aryShapes)
.Cells(intRowCount + i + 2, 1).Value = aryShapes(i)
Next i
For i = i = LBound(aryShapes) To UBound(aryShapes)
For j = UBound(aryShapes) To i Step -1
If aryShapes(i) > aryShapes(j) Then
swap = aryShapes(i)
aryShapes(i) = aryShapes(j)
aryShapes(j) = swap
End If
Next j
Next i
lstShape.Clear
lstShape.ColumnCount = 3
lstShape.ColumnWidths = "200;200;50"
For i = LBound(aryShapes) To UBound(aryShapes)
.Cells(intRowCount + UBound(aryShapes) + i + 4, 1).Value = aryShapes(i)
aryShapeItems = Split(aryShapes(i), Chr(9))
lstShape.AddItem ""
lstShape.List(lstShape.ListCount - 1, 0) = aryShapeItems(2)
lstShape.List(lstShape.ListCount - 1, 1) = aryShapeItems(3)
lstShape.List(lstShape.ListCount - 1, 2) = aryShapeItems(4)
Next i
End With
End_cmdExecSearch:
On Error Resume Next
Exit Sub
Err_cmdExecSearch:
MsgBox "cmdExecSearch:" & CStr(Err.Number) & ":" & Err.Description
GoTo End_cmdExecSearch
End Sub
Private Sub lstShape_Click()
Dim strShapeItem As String
strShapeItem = lstShape.List(lstShape.ListIndex, 2)
With ActiveSheet.Shapes(Val(strShapeItem))
ActiveSheet.Range(.TopLeftCell.Address).Select
.Select
End With
End Sub
'
' Shape種別名取得(MsoShapeType 列挙型)
' https://learn.microsoft.com/ja-jp/dotnet/api/microsoft.office.core.msoshapetype?view=office-pia
'
Private Function fnGetTypeName(pobjShp As Shape) As String
Dim intType As Integer
Dim strTypeName As String
intType = pobjShp.Type
Select Case intType
Case msoShapeTypeMixed:
strTypeName = "値のみを返します。その他の状態の組み合わせを示します。"
Case msoAutoShape:
strTypeName = "オートシェイプ" & "[" & fnGetTypeName2(pobjShp.AutoShapeType) & "]"
Case msoCallout:
strTypeName = "引き出し線"
Case msoChart:
strTypeName = "グラフ"
Case msoComment:
strTypeName = "コメント"
Case msoFreeform:
strTypeName = "フリーフォーム"
Case msoGroup:
strTypeName = "グループ"
Case msoEmbeddedOLEObject:
strTypeName = "埋め込み OLE オブジェクト"
Case msoFormControl:
strTypeName = "フォーム コントロール"
Case msoLine:
strTypeName = "直線"
Case msoLinkedOLEObject:
strTypeName = "リンクされた OLE オブジェクト"
Case msoLinkedPicture:
strTypeName = "リンクされた図"
Case msoOLEControlObject:
strTypeName = "OLE コントロール オブジェクト"
Case msoPicture:
strTypeName = "図"
Case msoPlaceholder:
strTypeName = "プレースホルダ。"
Case msoTextEffect:
strTypeName = "テキスト効果。"
Case msoMedia:
strTypeName = "メディア。"
Case msoTextBox:
strTypeName = "テキスト ボックス"
Case msoScriptAnchor:
strTypeName = "スクリプト アンカー。"
Case msoTable:
strTypeName = "テーブル。"
Case msoCanvas:
strTypeName = "キャンバス"
Case msoDiagram:
strTypeName = "ダイアグラム"
Case msoInk:
strTypeName = "墨。"
Case msoInkComment:
strTypeName = "インク コメント。"
Case msoSmartArt:
strTypeName = ""
Case msoSlicer:
strTypeName = ""
Case msoWebVideo:
strTypeName = "Web ビデオ。"
Case Else:
strTypeName = ""
End Select
fnGetTypeName = strTypeName
End Function
'
' Shape種別名取得2(MsoAutoShapeType 列挙型)
' https://learn.microsoft.com/ja-jp/dotnet/api/microsoft.office.core.msoautoshapetype?view=office-pia
'
Private Function fnGetTypeName2(pintType As Integer) As String
Dim strTypeName As String
Select Case pintType
Case msoShape10pointStar:
strTypeName = "10 ポイントの星"
Case msoShape12pointStar:
strTypeName = "12 ポイントの星"
Case msoShape16pointStar:
strTypeName = "16 ポイントの星"
Case msoShape24pointStar:
strTypeName = "24 ポイントの星"
Case msoShape32pointStar:
strTypeName = "32 ポイントの星"
Case msoShape4pointStar:
strTypeName = "4 点星"
Case msoShape5pointStar:
strTypeName = "5 点星"
Case msoShape6pointStar:
strTypeName = "6 点星"
Case msoShape7pointStar:
strTypeName = "7 点星"
Case msoShape8pointStar:
strTypeName = "8 点星"
Case msoShapeActionButtonBackorPrevious:
strTypeName = "[ 戻る] または [ 前へ] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonBeginning:
strTypeName = "[ 上旬] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonCustom:
strTypeName = "既定の画像またはテキストのないボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonDocument:
strTypeName = "[ 文書] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonEnd:
strTypeName = "[ 終了] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonForwardorNext:
strTypeName = "[ 進む] または [ 次へ] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonHelp:
strTypeName = "[ ヘルプ] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonHome:
strTypeName = "[ ホーム] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonInformation:
strTypeName = "[ 情報] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonMovie:
strTypeName = "[ ビデオ] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonReturn:
strTypeName = "[ 戻る] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeActionButtonSound:
strTypeName = "[ サウンド] ボタン。 マウスクリックおよびマウスオーバー動作をサポートします。"
Case msoShapeArc:
strTypeName = "アーク"
Case msoShapeBalloon:
strTypeName = "風船"
Case msoShapeBentArrow:
strTypeName = "90°の曲線に続くブロック矢印。"
Case msoShapeBentUpArrow:
strTypeName = "90°の鋭角線に続くブロック矢印。 既定では上向きです。"
Case msoShapeBevel:
strTypeName = "Bevel"
Case msoShapeBlockArc:
strTypeName = "円弧をブロックする"
Case msoShapeCan:
strTypeName = "Cna"
Case msoShapeChartPlus:
strTypeName = "四角形を垂直方向と水平方向に 4 四分の 4 に分割"
Case msoShapeChartStar:
strTypeName = "垂直線と対角線に沿って 6 つの部分に分割された正方形"
Case msoShapeChartX:
strTypeName = "対角線に沿って 4 つの部分に分割された正方形"
Case msoShapeChevron:
strTypeName = "Chevron"
Case msoShapeChord:
strTypeName = "円の内側を通って境界上の 2 つのポイントを結ぶ線を持つ円。和音を持つ円"
Case msoShapeCircularArrow:
strTypeName = "曲線 180 度の角度に続くブロック矢印"
Case msoShapeCloud:
strTypeName = "クラウドシェイプ"
Case msoShapeCloudCallout:
strTypeName = "クラウド吹き出し"
Case msoShapeCorner:
strTypeName = "四角形の欠落部分がある四角形。"
Case msoShapeCornerTabs:
strTypeName = "四角形の形に沿って配置された 4 つの直角三角形。4 つの切り取られた角部分。"
Case msoShapeCross:
strTypeName = "交差"
Case msoShapeCube:
strTypeName = "キューブ"
Case msoShapeCurvedDownArrow:
strTypeName = "下にカーブするブロック矢印"
Case msoShapeCurvedDownRibbon:
strTypeName = "下にカーブするリボン バナー"
Case msoShapeCurvedLeftArrow:
strTypeName = "左にカーブするブロック矢印"
Case msoShapeCurvedRightArrow:
strTypeName = "右にカーブするブロック矢印"
Case msoShapeCurvedUpArrow:
strTypeName = "上にカーブするブロック矢印"
Case msoShapeCurvedUpRibbon:
strTypeName = "上にカーブするリボン バナー"
Case msoShapeDecagon:
strTypeName = "デカゴン"
Case msoShapeDiagonalStripe:
strTypeName = "2 つの三角形の図形が削除された四角形。対角線"
Case msoShapeDiamond:
strTypeName = "ひし形"
Case msoShapeDodecagon:
strTypeName = "12 角形。"
Case msoShapeDonut:
strTypeName = "ドーナツ"
Case msoShapeDoubleBrace:
strTypeName = "二重かっこ"
Case msoShapeDoubleBracket:
strTypeName = "二重角かっこ"
Case msoShapeDoubleWave:
strTypeName = "ダブルウェーブ"
Case msoShapeDownArrow:
strTypeName = "下向きのブロック矢印"
Case msoShapeDownArrowCallout:
strTypeName = "下向きの矢印を使用した吹き出し"
Case msoShapeDownRibbon:
strTypeName = "リボンの端の下に中央の領域があるリボン バナー"
Case msoShapeExplosion1:
strTypeName = "Explosion"
Case msoShapeExplosion2:
strTypeName = "Explosion"
Case msoShapeFlowchartAlternateProcess:
strTypeName = "代替プロセス フローチャート 記号"
Case msoShapeFlowchartCard:
strTypeName = "カードフローチャート記号"
Case msoShapeFlowchartCollate:
strTypeName = "フローチャート記号を照合する"
Case msoShapeFlowchartConnector:
strTypeName = "コネクタ フローチャート 記号"
Case msoShapeFlowchartData:
strTypeName = "データ フローチャート 記号"
Case msoShapeFlowchartDecision:
strTypeName = "デシジョン フローチャート 記号"
Case msoShapeFlowchartDelay:
strTypeName = "遅延フローチャート記号"
Case msoShapeFlowchartDirectAccessStorage:
strTypeName = "直接アクセスストレージフローチャート記号"
Case msoShapeFlowchartDisplay:
strTypeName = "フローチャート記号を表示する"
Case msoShapeFlowchartDocument:
strTypeName = "ドキュメント フローチャート 記号"
Case msoShapeFlowchartExtract:
strTypeName = "フローチャート記号の抽出"
Case msoShapeFlowchartInternalStorage:
strTypeName = "内部ストレージ フローチャート 記号"
Case msoShapeFlowchartMagneticDisk:
strTypeName = "磁気ディスクフローチャート記号"
Case msoShapeFlowchartManualInput:
strTypeName = "手動入力フローチャート記号"
Case msoShapeFlowchartManualOperation:
strTypeName = "手動操作フローチャート記号"
Case msoShapeFlowchartMerge:
strTypeName = "差し込みフローチャート記号"
Case msoShapeFlowchartMultidocument:
strTypeName = "複数文書フローチャート記号"
Case msoShapeFlowchartOfflineStorage:
strTypeName = "オフライン ストレージ フローチャート 記号"
Case msoShapeFlowchartOffpageConnector:
strTypeName = "オフページ コネクタ フローチャート 記号"
Case msoShapeFlowchartOr:
strTypeName = "Or フローチャート 記号"
Case msoShapeFlowchartPredefinedProcess:
strTypeName = "定義済みのプロセス フローチャート 記号"
Case msoShapeFlowchartPreparation:
strTypeName = "準備フローチャート記号"
Case msoShapeFlowchartProcess:
strTypeName = "プロセス フローチャート 記号"
Case msoShapeFlowchartPunchedTape:
strTypeName = "パンチテープフローチャート記号"
Case msoShapeFlowchartSequentialAccessStorage:
strTypeName = "順次アクセス・ストレージフローチャート記号"
Case msoShapeFlowchartSort:
strTypeName = "並べ替えフローチャート記号"
Case msoShapeFlowchartStoredData:
strTypeName = "格納されたデータ フローチャート 記号"
Case msoShapeFlowchartSummingJunction:
strTypeName = "加算ジャンクション フローチャート 記号"
Case msoShapeFlowchartTerminator:
strTypeName = "ターミネータ フローチャート 記号"
Case msoShapeFoldedCorner:
strTypeName = "折り曲げコーナー"
Case msoShapeFrame:
strTypeName = "長方形の額縁"
Case msoShapeFunnel:
strTypeName = "漏斗"
Case msoShapeGear6:
strTypeName = "6本の歯を持つギア"
Case msoShapeGear9:
strTypeName = "歯が 9 個ある歯車。"
Case msoShapeHalfFrame:
strTypeName = "長方形の額縁の半分"
Case msoShapeHeart:
strTypeName = "心"
Case msoShapeHeptagon:
strTypeName = "Heptagon"
Case msoShapeHexagon:
strTypeName = "六角 形"
Case msoShapeHorizontalScroll:
strTypeName = "水平スクロール"
Case msoShapeIsoscelesTriangle:
strTypeName = "三角形の三角形"
Case msoShapeLeftArrow:
strTypeName = "左を指すブロック矢印"
Case msoShapeLeftArrowCallout:
strTypeName = "左を指す矢印を使用した吹き出し"
Case msoShapeLeftBrace:
strTypeName = "左かっこ"
Case msoShapeLeftBracket:
strTypeName = "左角かっこ"
Case msoShapeLeftCircularArrow:
strTypeName = "反時計回りを指す円形の矢印"
Case msoShapeLeftRightArrow:
strTypeName = "左右の両方を指す矢印付きのブロック矢印"
Case msoShapeLeftRightArrowCallout:
strTypeName = "左と右の両方を指す矢印付きの吹き出し"
Case msoShapeLeftRightCircularArrow:
strTypeName = "時計回りと反時計回りを指す円形の矢印。両端にポイントがある曲線矢印"
Case msoShapeLeftRightRibbon:
strTypeName = "両端に矢印が付いたリボン"
Case msoShapeLeftRightUpArrow:
strTypeName = "左、右、上を指す矢印を含むブロック矢印"
Case msoShapeLeftUpArrow:
strTypeName = "左と上を指す矢印が付いたブロック矢印"
Case msoShapeLightningBolt:
strTypeName = "稲妻"
Case msoShapeLineCallout1:
strTypeName = "罫線と水平吹き出し線を使用した吹き出し"
Case msoShapeLineCallout1AccentBar:
strTypeName = "水平アクセント バーを使用した吹き出し"
Case msoShapeLineCallout1BorderandAccentBar:
strTypeName = "罫線と水平方向のアクセント バーを使用した吹き出し"
Case msoShapeLineCallout1NoBorder:
strTypeName = "水平線を使用した吹き出し"
Case msoShapeLineCallout2:
strTypeName = "斜めの直線を使用した吹き出し"
Case msoShapeLineCallout2AccentBar:
strTypeName = "斜め吹き出し線とアクセント バーを使用した吹き出し"
Case msoShapeLineCallout2BorderandAccentBar:
strTypeName = "罫線、対角線、アクセント バーを使用した吹き出し"
Case msoShapeLineCallout2NoBorder:
strTypeName = "罫線のない吹き出し線と対角線付き吹き出し線"
Case msoShapeLineCallout3:
strTypeName = "斜線を使用した吹き出し"
Case msoShapeLineCallout3AccentBar:
strTypeName = "角度付き吹き出し線とアクセント バーを使用した吹き出し"
Case msoShapeLineCallout3BorderandAccentBar:
strTypeName = "罫線、角度付き吹き出し線、アクセント バーを含む吹き出し"
Case msoShapeLineCallout3NoBorder:
strTypeName = "罫線と角度付き吹き出し線のない吹き出し"
Case msoShapeLineCallout4:
strTypeName = "U 図形を形成する吹き出し線セグメントを含む吹き出し"
Case msoShapeLineCallout4AccentBar:
strTypeName = "U 図形を形成するアクセント バーと吹き出し線セグメントを含む吹き出し"
Case msoShapeLineCallout4BorderandAccentBar:
strTypeName = "U 図形を形成する罫線、アクセント バー、吹き出し線セグメントを含む吹き出し"
Case msoShapeLineCallout4NoBorder:
strTypeName = "U 図形を形成する罫線セグメントと吹き出し線セグメントのない吹き出し"
Case msoShapeLineInverse:
strTypeName = "線の逆数"
Case msoShapeMathDivide:
strTypeName = "除算記号 ÷"
Case msoShapeMathEqual:
strTypeName = "等価記号 ="
Case msoShapeMathMinus:
strTypeName = "減算記号 -"
Case msoShapeMathMultiply:
strTypeName = "乗算記号 x"
Case msoShapeMathNotEqual:
strTypeName = "非等価記号 ≠"
Case msoShapeMathPlus:
strTypeName = "加算記号 +"
Case msoShapeMixed:
strTypeName = "値のみを返します。その他の状態の組み合わせを示します。"
Case msoShapeMoon:
strTypeName = "月"
Case msoShapeNonIsoscelesTrapezoid:
strTypeName = "非対称非平行辺を持つ台形"
Case msoShapeNoSymbol:
strTypeName = "いいえ 記号"
Case msoShapeNotchedRightArrow:
strTypeName = "右を指すノッチ付きブロック矢印"
Case msoShapeNotPrimitive:
strTypeName = "非サポート"
Case msoShapeOctagon:
strTypeName = "オクタゴン"
Case msoShapeOval:
strTypeName = "楕円"
Case msoShapeOvalCallout:
strTypeName = "楕円型吹き出し"
Case msoShapeParallelogram:
strTypeName = "平行 四辺形"
Case msoShapePentagon:
strTypeName = "ペンタゴン"
Case msoShapePie:
strTypeName = "一部が欠落している円 ('pie')"
Case msoShapePieWedge:
strTypeName = "円形図形の 4 分の 1"
Case msoShapePlaque:
strTypeName = "プラーク"
Case msoShapePlaqueTabs:
strTypeName = "四角形の図形を定義する 4 つの四分円"
Case msoShapeQuadArrow:
strTypeName = "上、下、左、右を指すブロック矢印"
Case msoShapeQuadArrowCallout:
strTypeName = "上、下、左、右を指す矢印を使用した吹き出し"
Case msoShapeRectangle:
strTypeName = "四角形"
Case msoShapeRectangularCallout:
strTypeName = "長方形吹き出し"
Case msoShapeRegularPentagon:
strTypeName = "ペンタゴン"
Case msoShapeRightArrow:
strTypeName = "右を指すブロック矢印"
Case msoShapeRightArrowCallout:
strTypeName = "右を指す矢印を使用した吹き出し"
Case msoShapeRightBrace:
strTypeName = "右中かっこ"
Case msoShapeRightBracket:
strTypeName = "右角かっこ"
Case msoShapeRightTriangle:
strTypeName = "右三角形"
Case msoShapeRound1Rectangle:
strTypeName = "角を丸めた四角形"
Case msoShapeRound2DiagRectangle:
strTypeName = "2 つの角を丸めた四角形(対角線付き)"
Case msoShapeRound2SameRectangle:
strTypeName = "辺を共有する角が 2 角の四角形"
Case msoShapeRoundedRectangle:
strTypeName = "角丸四角形"
Case msoShapeRoundedRectangularCallout:
strTypeName = "四角形の丸みを帯びた吹き出し"
Case msoShapeSmileyFace:
strTypeName = "スマイリーフェイス"
Case msoShapeSnip1Rectangle:
strTypeName = "1 つの角が切り取られた四角形"
Case msoShapeSnip2DiagRectangle:
strTypeName = "斜め対向する 2 つの角を持つ四角形"
Case msoShapeSnip2SameRectangle:
strTypeName = "辺を共有する 2 つの角が切り取られた四角形"
Case msoShapeSnipRoundRectangle:
strTypeName = "1 つの角が切り取られ、角が丸い四角形"
Case msoShapeSquareTabs:
strTypeName = "四角形の図形を定義する 4 つの小さな四角形"
Case msoShapeStripedRightArrow:
strTypeName = "末尾にストライプが付いた右を指すブロック矢印"
Case msoShapeSun:
strTypeName = "日"
Case msoShapeSwooshArrow:
strTypeName = "曲線矢印"
Case msoShapeTear:
strTypeName = "水滴"
Case msoShapeTrapezoid:
strTypeName = "台形"
Case msoShapeUpArrow:
strTypeName = "上を指すブロック矢印"
Case msoShapeUpArrowCallout:
strTypeName = "上を指す矢印を使用した吹き出し"
Case msoShapeUpDownArrow:
strTypeName = "上下を指すブロック矢印"
Case msoShapeUpDownArrowCallout:
strTypeName = "上下を指す矢印を使用した吹き出し"
Case msoShapeUpRibbon:
strTypeName = "リボンの端の上に中央の領域があるリボン バナー"
Case msoShapeUTurnArrow:
strTypeName = "U 図形を形成するブロック矢印"
Case msoShapeVerticalScroll:
strTypeName = "垂直スクロール"
Case msoShapeWave:
strTypeName = "小波"
Case Else:
strTypeName = ""
End Select
fnGetTypeName2 = strTypeName
End Function
2025 kokaki.jp, Office.