【マクロ】図形の種類などを取得(編集中コード)
Sub test_getShepesProperty() Dim str() As String str = getShapesProperty(ThisWorkbook.Name, ActiveSheet.Name) Dim msg As String Call addMsg(msg, "オートシェイプのプロパティを取得") Dim i As Long For i = 0 To UBound(str, 2) Call addMsg(msg, "図形:" + CStr(i + 1)) Call addMsg(msg, "図形種別(.Type):" + str(0, i)) Call addMsg(msg, "名称(.Name):" + str(1, i)) Call addMsg(msg, "文言(.TextFrame.Characters.text):" + str(2, i)) Call addMsg(msg, "左位置(.Left):" + str(3, i)) Call addMsg(msg, "上位置(.Top):" + str(4, i)) Call addMsg(msg, "幅(.Width):" + str(5, i)) Call addMsg(msg, "高さ(.Height):" + str(6, i)) Call addMsg(msg, "図形左上のセル(.TopLeftCell.Address):" + str(7, i)) Call addMsg(msg, "図形右下のセル(.BottomRightCell.Address):" + str(8, i)) Call addMsg(msg) Next i MsgBox msg End SubSub addMsg(msg As String, Optional addMsg = "") msg = msg + addMsg + vbCrLfEnd SubPublic Function getShapesProperty(bookName As String, sheetName As String) As String()'------------------------------------------'getShapesText'対象シート上にあるオブジェクトのプロパティを取得する'引数1:bookName as String 対象ブック名'引数2:sheetName as String 対象シート名'戻り:getShapesProperty as string(2,n)' (0,n) .type' (1,n) .name' (2,n) .TextFrame.Characters.text' (3,n) .Left' (4,n) .Top' (5,n) .Width' (6,n) .Height' (7,n) .TopLeftCell.Address(False, False)' (8,n) .BottomRightCell.Address(False, False)''------------------------------------------ Dim ret() As String Dim i As Long Dim obj As Object For Each obj In Workbooks(bookName).Sheets(sheetName).Shapes ReDim Preserve ret(8, i) As String ret(0, i) = CStr(obj.Type) ret(1, i) = CStr(obj.Name) 'TextFrameプロパティが使用できない(レイアウト枠がない)オブジェクトは除外 On Error Resume Next ret(2, i) = obj.TextFrame.Characters.Text ret(3, i) = CStr(obj.Left) ret(4, i) = CStr(obj.Top) ret(5, i) = CStr(obj.Width) ret(6, i) = CStr(obj.Height) ret(7, i) = CStr(obj.TopLeftCell.Address(False, False)) ret(8, i) = CStr(obj.BottomRightCell.Address(False, False)) Cells(1, i+1) = ret(0, i) Cells(2, i+1) = ret(1, i) Cells(3, i+1) = ret(2, i) Cells(4, i+1) = ret(3, i) Cells(5, i+1) = ret(4, i) Cells(6, i+1) = ret(5, i) Cells(7, i+1) = ret(6, i) Cells(8, i+1) = ret(7, i) Cells(9, i+1) = ret(8, i) i = i + 1 Next getShapesProperty = ret End Function