« ページ設定をコピーする | トップページ | セル内容をもとにPasteメソッドで文字列の図形を作成する »

2020年4月19日 (日)

図形のビジュアル一覧を作成する

シェイプを追加するには
AddShape メソッドを使用します。
次のコードは位置が左から10pt,上から10pt
幅100pt,高さ100ptの四角形を追加します。

 

Sub macro20200419a()
'四角形を追加

    ActiveSheet.Shapes.AddShape( _
        msoShapeRectangle, _
        10, 10, 100, 100).Select
   
End Sub

上のコードでmsoShapeRectangleの部分は
184種のオートシェイプのタイプが指定できます。

詳細は次のMicrosoftのWebページを参照ください。
MsoAutoShapeType 列挙 (Office)
うまく翻訳されていないので英文ページのリンクも貼ります。
MsoAutoShapeType enumeration (Office)

184種のオートシェイプをすべて作成してみます。

下のコードでは,
配列stにオートシェイプのタイプを格納しています。
その際にArray関数を使いますが,
行継続文字「 _」の使用は24回までで制限されているので
複数に分けて配列stに値を格納します。

msoShapeFlowchartSequentialAcessStorageは
「定数が定義されていません」という
エラーになるので除いてあります。

また,タイプ135,140はエラーになり作成されません。
エラーが起きてもコードの実行が中断されないように
On Error Resume Nextで
エラーを無視するようにしてあります。

どのタイプが分かりやすいように表示している文字は
四角形のシェイプで別途作成しています。

図形のビジュアル一覧を作成するコード:

Sub macro20200419b()
'図形のビジュアル一覧を作成する

    Dim i As Integer
    Dim ary()
    Dim st()
   
    Sheets.Add 'シート追加
   
    'オートシェイプのタイプを格納する配列stを作成
    ary = Array(msoShape10pointStar, msoShape12pointStar, _
        msoShape16pointStar, msoShape24pointStar, _
        msoShape32pointStar, msoShape4pointStar, _
        msoShape5pointStar, msoShape6pointStar, _
        msoShape7pointStar, msoShape8pointStar, _
        msoShapeActionButtonBackorPrevious, _
        msoShapeActionButtonBeginning, _
        msoShapeActionButtonCustom, _
        msoShapeActionButtonDocument, _
        msoShapeActionButtonEnd, _
        msoShapeActionButtonForwardorNext, _
        msoShapeActionButtonHelp, msoShapeActionButtonHome, _
        msoShapeActionButtonInformation, _
        msoShapeActionButtonMovie, _
        msoShapeActionButtonReturn, _
        msoShapeActionButtonSound, _
        msoShapeArc, msoShapeBalloon, _
        msoShapeBentArrow, msoShapeBentUpArrow, _
        msoShapeBevel, msoShapeBlockArc, _
        msoShapeCan, msoShapeChartPlus)
       
    st = ary
   
    ary = Array(msoShapeChartStar, msoShapeChartX, _
        msoShapeChevron, msoShapeChord, _
        msoShapeCircularArrow, msoShapeCloud, _
        msoShapeCloudCallout, msoShapeCorner, _
        msoShapeCornerTabs, msoShapeCross, _
        msoShapeCube, msoShapeCurvedDownArrow, _
        msoShapeCurvedDownRibbon, msoShapeCurvedLeftArrow, _
        msoShapeCurvedRightArrow, msoShapeCurvedUpArrow, _
        msoShapeCurvedUpRibbon, msoShapeDecagon, _
        msoShapeDiagonalStripe, msoShapeDiamond, _
        msoShapeDodecagon, msoShapeDonut, _
        msoShapeDoubleBrace, msoShapeDoubleBracket, _
        msoShapeDoubleWave, msoShapeDownArrow, _
        msoShapeDownArrowCallout, msoShapeDownRibbon, _
        msoShapeExplosion1, msoShapeExplosion2, _
        msoShapeFlowchartAlternateProcess, msoShapeFlowchartCard, _
        msoShapeFlowchartCollate, msoShapeFlowchartConnector, _
        msoShapeFlowchartData, msoShapeFlowchartDecision, _
        msoShapeFlowchartDelay, msoShapeFlowchartDirectAccessStorage, _
        msoShapeFlowchartDisplay, msoShapeFlowchartDocument)
       
    For i = 1 To UBound(ary)
        ReDim Preserve st(UBound(st) + 1)
        st(UBound(st)) = ary(i)
    Next i

    ary = Array(msoShapeFlowchartExtract, _
        msoShapeFlowchartInternalStorage, _
        msoShapeFlowchartMagneticDisk, msoShapeFlowchartManualInput, _
        msoShapeFlowchartManualOperation, msoShapeFlowchartMerge, _
        msoShapeFlowchartMultidocument, _
        msoShapeFlowchartOfflineStorage, _
        msoShapeFlowchartOffpageConnector, msoShapeFlowchartOr, _
        msoShapeFlowchartPredefinedProcess, _
        msoShapeFlowchartPreparation, _
        msoShapeFlowchartProcess, msoShapeFlowchartPunchedTape, _
        msoShapeFlowchartSort, _
        msoShapeFlowchartStoredData, _
        msoShapeFlowchartSummingJunction, _
        msoShapeFlowchartTerminator, msoShapeFoldedCorner, _
        msoShapeFrame, msoShapeFunnel, _
        msoShapeGear6, msoShapeGear9, _
        msoShapeHalfFrame, msoShapeHeart, _
        msoShapeHeptagon, msoShapeHexagon, _
        msoShapeHorizontalScroll, msoShapeIsoscelesTriangle)
'        msoShapeFlowchartSequentialAcessStorage, _

    For i = 1 To UBound(ary)
        ReDim Preserve st(UBound(st) + 1)
        st(UBound(st)) = ary(i)
    Next i

    ary = Array(msoShapeLeftArrow, msoShapeLeftArrowCallout, _
        msoShapeLeftBrace, msoShapeLeftBracket, _
        msoShapeLeftCircularArrow, msoShapeLeftRightArrow, _
        msoShapeLeftRightArrowCallout, _
        msoShapeLeftRightCircularArrow, _
        msoShapeLeftRightRibbon, msoShapeLeftRightUpArrow, _
        msoShapeLeftUpArrow, msoShapeLightningBolt, _
        msoShapeLineCallout1, msoShapeLineCallout1AccentBar, _
        msoShapeLineCallout1BorderandAccentBar, _
        msoShapeLineCallout1NoBorder, _
        msoShapeLineCallout2, msoShapeLineCallout2AccentBar, _
        msoShapeLineCallout2BorderandAccentBar, _
        msoShapeLineCallout2NoBorder, _
        msoShapeLineCallout3, msoShapeLineCallout3AccentBar, _
        msoShapeLineCallout3BorderandAccentBar, _
        msoShapeLineCallout3NoBorder, _
        msoShapeLineCallout4, msoShapeLineCallout4AccentBar, _
        msoShapeLineCallout4BorderandAccentBar, _
        msoShapeLineCallout4NoBorder, _
        msoShapeLineInverse, msoShapeMathDivide)

    For i = 1 To UBound(ary)
        ReDim Preserve st(UBound(st) + 1)
        st(UBound(st)) = ary(i)
    Next i
   
    ary = Array(msoShapeMathEqual, msoShapeMathMinus, _
        msoShapeMathMultiply, msoShapeMathNotEqual, _
        msoShapeMathPlus, msoShapeMixed, _
        msoShapeMoon, msoShapeNonIsoscelesTrapezoid, _
        msoShapeNoSymbol, msoShapeNotchedRightArrow, _
        msoShapeNotPrimitive, msoShapeOctagon, _
        msoShapeOval, msoShapeOvalCallout, _
        msoShapeParallelogram, msoShapePentagon, _
        msoShapePie, msoShapePieWedge, _
        msoShapePlaque, msoShapePlaqueTabs, _
        msoShapeQuadArrow, msoShapeQuadArrowCallout, _
        msoShapeRectangle, msoShapeRectangularCallout, _
        msoShapeRegularPentagon, msoShapeRightArrow, _
        msoShapeRightArrowCallout, msoShapeRightBrace, _
        msoShapeRightBracket, msoShapeRightTriangle, _
        msoShapeRound1Rectangle, msoShapeRound2DiagRectangle, _
        msoShapeRound2SameRectangle, msoShapeRoundedRectangle, _
        msoShapeRoundedRectangularCallout, msoShapeSmileyFace, _
        msoShapeSnip1Rectangle, msoShapeSnip2DiagRectangle, _
        msoShapeSnip2SameRectangle, msoShapeSnipRoundRectangle)

    For i = 1 To UBound(ary)
        ReDim Preserve st(UBound(st) + 1)
        st(UBound(st)) = ary(i)
    Next i

    ary = Array(msoShapeSquareTabs, msoShapeStripedRightArrow, _
        msoShapeSun, msoShapeSwooshArrow, _
        msoShapeTear, msoShapeTrapezoid, _
        msoShapeUpArrow, msoShapeUpArrowCallout, _
        msoShapeUpDownArrow, msoShapeUpDownArrowCallout, _
        msoShapeUpRibbon, msoShapeUTurnArrow, _
        msoShapeVerticalScroll, msoShapeWave)
       
    For i = 1 To UBound(ary)
        ReDim Preserve st(UBound(st) + 1)
        st(UBound(st)) = ary(i)
    Next i
    'オートシェイプのタイプを格納する配列stを作成 終了
   
    'シェイプを作成
    For i = 1 To UBound(st)
        '各種シェイプ作成
        On Error Resume Next
        ActiveSheet.Shapes.AddShape( _
            st(i), 30 + (i Mod 10) * 100, _
            10 + Int(i / 10) * 100, _
            70, 50).Select
        On Error GoTo 0
       
        '文字表示用四角形の作成
        ActiveSheet.Shapes.AddShape( _
            msoShapeRectangle, 30 + (i Mod 10) * 100, _
            10 + Int(i / 10) * 100, _
            70, 50).Select
        Selection.Text = i & Chr(10) & "type: " & st(i)
        With Selection.ShapeRange
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
        End With
        With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With

    Next i
   
End Sub

実行結果(一部):

Vba20200419a

使用Ver:Excel For Office365

 

|

« ページ設定をコピーする | トップページ | セル内容をもとにPasteメソッドで文字列の図形を作成する »

コメント

この記事へのコメントは終了しました。