tkhrsskの日記

技術ネタなど

EXCEL VBA PFDの図形を書くマクロ

f:id:tkhrssk:20170604012713p:plain

上記を固定で出力するマクロです。

これだけだとテンプレ用意するのと何の変わりもないけど、 GraphVizとかみたいに、必要な情報を表で埋めたら全部自動でオブジェクト作れるようにしたいとは思っている。 配置自動調整まではさすがにするつもりないけど。

Sub MacroPFD()
    Dim ShapeProc As shape, ShapeDoc As shape, ShapeCon As shape
    Dim ShapeDocIn As shape, ShapeConIn As shape
    
    Set ShapeProc = ActiveSheet.Shapes.AddShape(msoShapeOval, 200, 100, 100, 80)
    MacroStyle ShapeProc, "P1" & Chr(13) & "設計する"

    Set ShapeDoc = ActiveSheet.Shapes.AddShape(msoShapeFlowchartDocument, 350, 110, 100, 60)
    MacroStyle ShapeDoc, "D1" & Chr(13) & "設計書"
    
    Set ShapeDocIn = ActiveSheet.Shapes.AddShape(msoShapeFlowchartDocument, 50, 110, 100, 60)
    MacroStyle ShapeDocIn, "D0" & Chr(13) & "仕様書"
    
    Set ShapeCon = ActiveSheet.Shapes.AddConnector(msoConnectorCurve, 100, 100, 100, 100)
    ShapeCon.Line.EndArrowheadStyle = msoArrowheadTriangle
    ShapeCon.ShapeStyle = msoLineStylePreset29
    ShapeCon.ConnectorFormat.BeginConnect ShapeProc, 7
    ShapeCon.ConnectorFormat.EndConnect ShapeDoc, 2

    Set ShapeConIn = ActiveSheet.Shapes.AddConnector(msoConnectorCurve, 100, 100, 100, 100)
    ShapeConIn.Line.EndArrowheadStyle = msoArrowheadTriangle
    ShapeConIn.ShapeStyle = msoLineStylePreset29
    ShapeConIn.ConnectorFormat.BeginConnect ShapeDocIn, 4
    ShapeConIn.ConnectorFormat.EndConnect ShapeProc, 3

End Sub

Sub MacroStyle(shape, text)
    
    shape.ShapeStyle = msoShapeStylePreset1
        
    With shape.TextFrame2
        With .TextRange
            With .Characters
                .text = text
                With .ParagraphFormat
                    .FirstLineIndent = 0
                    .Alignment = msoAlignCenter
                End With
            End With
            
            With .Font
                .NameComplexScript = "+mn-cs"
                .NameFarEast = "+mn-ea"
                .Fill.Visible = msoTrue
                .Fill.ForeColor.TintAndShade = 0
                .Fill.ForeColor.Brightness = 0
                .Fill.Transparency = 0
                .Fill.Solid
                .Size = 11
                .Name = "+mn-lt"
            End With
        End With
        .VerticalAnchor = msoAnchorMiddle
        .WordWrap = msoFalse
    End With

End Sub

おまけ

f:id:tkhrssk:20170604014016p:plain

コネクタ番号のメモ

参考