【VBA】エクセルでフローチャート

2024年6月13日

エクセルでフローチャート
個別削除と一括選択して削除
コードの紹介
作ってみて・使ってみて

エクセルでフローチャート

VBAでプログラムを書くときにフローチャートが便利かと思い、簡単に作成できるようにしてみました。

マクロ実行ボタンが遠いとマウス移動が手間なので、
ユーザーフォームが近くに開くようにして簡単に項目を追加できるように工夫しています。

個別削除と一括選択して削除

選択した図形とそこに繋がっているコネクタ線も一緒に削除できるのと、セル選択範囲上の図形を一括選択して一気に削除もできます。

コードの紹介

ダブルクリックしたセルに開始のシェイプを配置する

ダブルクリックイベントを使用します。

▼ワークシートモジュールに記述

'セルをダブルクリックした時に実行
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    '4行目より下でダブルクリックした時のみ実行
    If Target.Row > 4 Then
        Cancel = True
        Call セルクリック(Target)
    End If

End Sub

ダブルクリックした位置にユーザーフォームを立ち上げる処理はこのサイトのコードを使用させていただいています。

参考VBA応用(ユーザーフォーム表示位置の制御)Excelでお仕事！

▼標準モジュール

Sub セルクリック(Target As Range)
    
    'クリックした位置にユーザーフォームを開く
    Call ShowFormFromRange(Target, "UserForm1")

End Sub

（※一部指定のユーザーフォーム名を引数として渡す部分だけ変更しています。）

▼ユーザーフォーム「UserForm1」

'ユーザーフォームを立ち上げたときに画像を読み込み
Private Sub UserForm_Initialize()

    '表示させる画像を保存しているフォルダパス
    Dim fldPath As String
    fldPath = ThisWorkbook.Path & "\img\"
        
    With img_開始
        .Picture = LoadPicture(fldPath & "開始.gif")  '表示させる画像
        .PictureSizeMode = fmPictureSizeModeZoom      '枠にサイズを合わせる
        .PictureAlignment = fmPictureAlignmentCenter  '中央配置
        .BorderStyle = fmBorderStyleNone              '枠なし
    End With

End Sub

'ユーザーフォームの開始画像をクリックした時に実行
Private Sub img_開始_Click()

    Call 開始
    Unload Me
    
End Sub

▼ユーザーフォームの開始ボタンをクリックした後の処理

Sub 開始()
    
    'シェイプを作成（セルの２×２マス分のサイズ）
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddShape(Type:=msoShapeFlowchartTerminator, _
        Left:=ActiveCell.Left, Top:=ActiveCell.Top, _
        Width:=ActiveCell.Width * 2, Height:=ActiveCell.Height * 2)

    'シェイプ設定(図形, 色, テキスト)
    Call シェイプ設定(shp, RGB(204, 255, 255), "開始")
    
    '作成したシェイプにマクロを設定
    shp.OnAction = "シェイプクリック"
    
    'シェイプの選択を外すためにセルを選択
    shp.TopLeftCell.Resize(2, 2).Select
        
End Sub

'全ての図形で使う処理なのでサブルーチン化
Private Sub シェイプ設定(shp As Shape, 背景色 As String, テキスト As String)

    With shp
        .Fill.ForeColor.RGB = 背景色
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        .TextFrame.Characters.Text = テキスト
        .TextFrame.HorizontalAlignment = xlCenter  'テキスト中央配置（水平方向）
        .TextFrame.VerticalAlignment = xlVAlignCenter 'テキスト中央配置（垂直方向）
        .TextFrame.HorizontalOverflow = xlOartHorizontalOverflowOverflow '横にはみ出して表示
        .TextFrame.VerticalOverflow = xlOartHorizontalOverflowOverflow  '縦にはみ出して表示
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = rgbBlack '黒色
        .TextFrame2.WordWrap = msoFalse '図形内でテキストを折り返さない
        .Shadow.Visible = True '影
        .Shadow.Transparency = 0.5
        .Shadow.OffsetX = 1
        .Shadow.OffsetY = 1
        .Shadow.Blur = 2
        .Select
    End With

End Sub

開始のシェイプ設置方法（簡易版）

とりあえず一番簡単にできるユーザーフォームを使用しない＆テキスト入力の方法も紹介します。

ユーザーフォームを使わないので手軽に作成できますが、
デメリットはインブットボックスの位置がクリックした位置にならないことです。

▼ワークシートモジュール

'セルをダブルクリックした時に実行
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    '５行目より下をダブルクリックした時だけ実行
    If Target.Row >= 5 Then
        Cancel = True
        Call 開始(Target)
    End If

End Sub

▼標準モジュール

Sub 開始(Target As Range)

    'テキストインプットボックスで入力する
    Dim txt As String
    txt = InputBox("文字を入力してください。")
    
    '入力されていなかったら終了
    If txt = "" Then Exit Sub

    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddShape(Type:=msoShapeFlowchartTerminator, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width * 2, Height:=ActiveCell.Height * 2)

    'シェイプ設定(図形, 色, テキスト)
    Call シェイプ設定(shp, RGB(204, 255, 255), txt)

    shp.OnAction = "シェイプクリック"
    shp.TopLeftCell.Resize(2, 2).Select
        
End Sub

call シェイプ設定は上と同じです。

開始のシェイプ設置方法（ユーザーフォームでテキスト入力付き）

開始のシェイプをテキスト入力できるようにする

ユーザーフォームのコードはTextBox1.Textを引数として渡す部分だけ追加してます。

Private Sub img_開始_Click()

    Call 開始(TextBox1.Text)
    Unload Me
    
End Sub

開始のコードもtxtを引数として受け取っている部分だけ追加しています。

Sub 開始(txt As String)

    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddShape(Type:=msoShapeFlowchartTerminator, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width * 2, Height:=ActiveCell.Height * 2)

    'シェイプ設定(図形, 色, テキスト)
    Call シェイプ設定(shp, RGB(204, 255, 255), txt)

    shp.OnAction = "シェイプクリック"
    shp.TopLeftCell.Resize(2, 2).Select
        
End Sub

シェイプをクリックして項目をコネクタ線付きで追加する

上記コード内の OnActionにシェイプをクリックした時に実行されるプロシージャ名を設定している。

shp.OnAction = “シェイプクリック”

作成したシェイプをクリックすると「シェイプクリック」というプロシージャでユーザーフォームを起動させています。

作成したシェイプをクリックした時の処理

Sub シェイプクリック()

    'クリックしたシェイプの下のセルを取得
    Dim shpRng As Range
    Set shpRng = Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address)

    'シェイプの名前を取得
    shpName = Application.Caller
    
    'クリックしたシェイプのテキストを取得
    myText = ActiveSheet.Shapes(shpName).TextFrame.Characters.Text
    
    'クリックした位置にユーザーフォームを開く
    Call ShowFormFromRange(shpRng, "UserForm2")

End Sub

シェイプの形によって「シェイプのタイプ」と「コネクタ線を繋ぐ位置」が異なります。

「処理」のシェイプを作成する処理

Sub 処理_下()

    'クリックしたシェイプの名前を取得
    Dim shpName As String
    shpName = Application.Caller
    
    'クリックしたシェイプ
    Dim shp1 As Shape
    Set shp1 = ActiveSheet.Shapes(shpName)

    '作成するシェイプ
    Dim shp2 As Shape
    Set shp2 = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=shp1.Left, Top:=shp1.Top + shp1.Height * 1.5, Width:=shp1.Width, Height:=shp1.Height)
    
    '直線コネクタをとりあえず挿入
    Dim shpCon As Shape
    Set shpCon = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 1, 1, 1, 1)
    
    '図形設定(図形, 背景色, テキスト)
    Call 図形設定(shp2, RGB(255, 255, 204), "処理")
    
    'コネクタ設定(コネクタ, 始点図形, 終点図形 矢印始点, 矢印終点)
    If shp1.AutoShapeType = msoShapeSnip2SameRectangle Then
        Call コネクタ設定(shpCon, shp1, shp2, 2, 1)
    Else
        Call コネクタ設定(shpCon, shp1, shp2, 3, 1)
    End If
    
    'さらに作成したシェイプにもマクロを設定する
    shp2.OnAction = "シェイプクリック"
    
    'シェイプの下のセルを選択する
    shp2.TopLeftCell.Resize(2, 2).Select

End Sub

'コネクタ（矢印）の設定
Sub コネクタ設定(コネクタ As Shape, 始点図形 As Shape, 終点図形 As Shape, 矢印始点 As Long, 矢印終点 As Long)

    With コネクタ
        .ConnectorFormat.BeginConnect 始点図形, 矢印始点
        .ConnectorFormat.EndConnect 終点図形, 矢印終点
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        .Line.EndArrowheadStyle = msoArrowheadOpen '終端を矢印に変更
    End With

End Sub

シェイプのタイプとコネクタ線を繋ぐ番号はこのようになっています。
矢印の始点と終点を番号で指定します。

「繰り返し」の図形だけコネクタを繋ぐ番号が他と異なるため、if文で分けています。

If shp1.AutoShapeType = msoShapeSnip2SameRectangle Then

「カラフル」と「シンプル」で色を切り替える処理

'カラフルかシンプルのセルをダブルクリックした時に実行する処理
Sub テーマ変更_図形(Target As Range)

    Dim shp As Shape

    '「カラフル」が選択されていたら
    If Target = Range("テーマ").Cells(1) Then
        For Each shp In ActiveSheet.Shapes
            If shp.Top > Range("A5").Top Then '5行目より下にだけ実行
                '形状別色付け
                Select Case shp.AutoShapeType
                    Case msoShapeFlowchartTerminator '端子フローチャート記号(69)
                        shp.Fill.ForeColor.RGB = RGB(204, 255, 255) 'スカイブルー
                    Case msoShapeRectangle '四角形(1)
                        If shp.TextFrame.Characters.Text <> "True" _
                            And shp.TextFrame.Characters.Text <> "False" Then
                            shp.Fill.ForeColor.RGB = RGB(255, 255, 204) '薄い黄
                        End If
                    Case msoShapeSnip2SameRectangle '1 辺を共有する 2 つの角が欠けている四角形(156)
                        shp.Fill.ForeColor.RGB = RGB(204, 255, 204) '薄い緑
                    Case msoShapeFlowchartDecision '判断フローチャート記号(63)
                        shp.Fill.ForeColor.RGB = RGB(255, 204, 255) 'ラベンダー
                    Case msoShapeFlowchartPredefinedProcess '定義済みフローチャート記号(65)
                        shp.Fill.ForeColor.RGB = RGB(255, 204, 204) 'ローズ
                End Select
            End If
        Next shp
        
    '「シンプル」が選択されていたら
    Else
        For Each shp In ActiveSheet.Shapes
            If shp.Top > Range("A5").Top Then '5行目より下にだけ実行
                If Not shp.Connector Then 'コネクタ以外
                    shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = rgbBlack 'フォント色：黒
                    shp.Fill.ForeColor.RGB = rgbWhite '背景色：白
                End If
            End If
        Next shp
    End If
    
End Sub

コネクタ線を繋ぐ

項目追加の時は自動でコネクタ線も付きますが、分岐して正規ルートに戻る時は自分で線を繋ぐ必要があります。

これは選択した２つの図形を上から下に真っすぐ繋ぐコードです。

'シェイプ１の下側から線が出てシェイプ２の上側に繋ぐ
Sub 直線コネクタ下上()

    Dim firstShape As Shape     '上にある図形
    Dim secondShape As Shape    '下にある図形
    Dim shpCon As Shape         'コネクタ
    
    'エラーなら下に飛ぶ
    On Error GoTo ErrJump
    
    '図形が二つ選択されていたら
    If Selection.ShapeRange.Count = 2 Then
        '選択された図形がコネクタだったらメッセージを出して終了
        If Selection.ShapeRange(1).Connector Or Selection.ShapeRange(2).Connector = msoTrue Then
            MsgBox "コネクタではなく､図形を選択してください。"
            Exit Sub
        End If
        
        '選択した1つ目の図形の位置が上にある場合
        If Selection.ShapeRange(1).Top < Selection.ShapeRange(2).Top Then
            Set firstShape = Selection.ShapeRange(1) '上の方にある図形をfirstShapeに代入
            Set secondShape = Selection.ShapeRange(2) '下の方にある図形をsecondShapeに代入
        '選択した2つ目の図形の位置が上にある場合
        Else
            Set firstShape = Selection.ShapeRange(2) '上の方にある図形をfirstShapeに代入
            Set secondShape = Selection.ShapeRange(1) '下の方にある図形をsecondShapeに代入
        End If
            
        'コネクタ線を作成
        Set shpCon = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 1, 1, 1, 1)
        
        'コネクタを繋ぐ(msoShapeSnip2SameRectangleだけ番号が違うので条件分岐)
        With shpCon
            .Line.EndArrowheadStyle = msoArrowheadOpen
            If firstShape.AutoShapeType = msoShapeSnip2SameRectangle Then
                .ConnectorFormat.BeginConnect firstShape, 2 '4上、3左、2下、1右
            Else
                .ConnectorFormat.BeginConnect firstShape, 3 '1上、2左、3下、4右
            End If
            If secondShape.AutoShapeType = msoShapeSnip2SameRectangle Then
                .ConnectorFormat.EndConnect secondShape, 4  '4上、3左、2下、1右
            Else
                .ConnectorFormat.EndConnect secondShape, 1 '1上、2左、3下、4右
            End If
            .Line.ForeColor.RGB = RGB(0, 0, 0)
            .Line.EndArrowheadStyle = msoArrowheadOpen '終端を矢印に変更
        End With
    
    Else
        MsgBox "図形を二つ選択してください"
    End If
    
    Exit Sub
    
ErrJump:
    MsgBox "図形を二つ選択してください"

End Sub

図形を２つ選択していない時や、コネクタ線を選択してしまている時のエラー処理が含まれています。
また、上から下に線を繋ぐため、図形をどの順番で選択しても動作するようにしています。

下記リンク先で紹介されていた方法を使わせていただいています。

参考面倒なフローチャート作成をクリック一つで作成できるツールのダウンロードページです！｜メンタエクセル｜notenote（ノート）