Excel VBA ツール : オートシェイプ内の文字列をセルに一覧出力する

今回は、 オートシェイプの文字列を一覧に出力してくれる Excel VBA の ツール を作ってみたのでシェアしますね。

こんにちは、ゆう(@ProgYuki)です。

普段仕事をする中で頻繁にExcelを使うと思うのですが、

「オートシェイプに書いてある文字列をセルに出力したい」

っていう場面ないですか？

私は今まで何度もありました。

オートシェイプは視覚的に表現したい場合には有用なのですが、データとして扱うにはとても不便なので、基本的にあらゆる場面で乱用するのはやめていただきたいわけですが、チームの中にいろんなコメントをオートシェイプ に書いて残す方とかたまにいますよね。

また、オートシェイプでフローチャートを視覚的にを作った上で、それを工程表としてデータベースのようにまとめたいってこともあると思います。

私は以前BPR（業務改善）コンサルティングの会社にいた時にプロセスフローと工程表の両方を成果物として作る必要があったので、

「オートシェイプの文字列をセルに一覧で出力できたら便利だな〜」

ってよく思ってました。

それで今結構余裕があるので、プログラミングの勉強と業務効率化を兼ねて作ってみました！

のでシェアしますね。

同じようなニーズがある方やVBAの勉強してみたい方は、この記事内にコードも全表示しているので、参考にしていただければと思います。

Excel VBA ツール : オートシェイプ内の文字列を一覧に出力する

マクロ ツール の機能、使用用途、使い方

機能

このツールの機能は、

Excel ブックに含まれる全てのシートの全てのオートシェイプの文字列を抽出して、

• シート名
• オートシェイプ名
• オートシェイプ内の文字列

を指定したセルに一覧に出力する、というものです。

使用用途

使用用途は、想定としては

• オートシェイプに記載されたコメントを一覧表示して対応の漏れをなくしたい
• フローチャートから工程表作成の手間を省きたい

てな感じです。

使い方によってはいろんなところで使えるツールだと思います。

使い方

コードをコピーする場所やプログラムの起動の仕方は後ほど説明しますが、使い方としては、

1. 何かしらのオートシェイプがある状態で
2. VBAプログラムを起動して
3. 文字列一覧を出力したいセルを指定すると
4. 自動的に文字列一覧のテーブルが作成される

という流れになります。

画像つきで示すと、

①何かしらのオートシェイプがある状態で

例として適当にオートシェイプを作ってみました。

各オートシェイプ内に書いてある文字列（text1 , text 2 ..etc）が今回セルに出力したい文字列です。

②VBAプログラムを起動して

起動の仕方はいろいろとあります。

ご自身でも調べてみると良いと思いますが、一番わかりやすい方法としては、

「開発」→「マクロ」

と進むと実行できるマクロの一覧が表示されるので、そこで今回は「shapeObjectList」という名前にしているので、それを選択して「実行」を押せば実行されます。

うまくできましたかね？
もし、何かエラー等があれば、コメントかTweetでご連絡いただけると幸いです。

③文字列一覧を出力したいセルを指定すると

今回のツールは起動するとポップアップが出てきて、出力先のセルを指定できるようにしてます。

適当なセルをクリックして指定ください。

④自動的に文字列一覧のテーブルが作成される

セルを指定した後に「OK」をクリックすれば自動的に一覧の表が作成されます。

VBA コードの表示

コードの全文は下記の通りです。

Sub accelerate()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

End Sub

Sub clearAccelerate()

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Sub shapeObjectList()

On Error GoTo Err

    Dim sheets As Worksheet, i As Integer, m As Integer, O As Shape, thisSheet As Worksheet
    Set thisSheet = ActiveSheet
   
    Dim rng As Range
    Set rng = Application.InputBox(prompt:="Choose the cell to open the table", Type:=8)
    
    Dim n As Integer

    i = rng.Row
    m = rng.Column

    Call accelerate

Done:

    With thisSheet
        .Cells(i, m).Value = "Sheet Name"
        .Cells(i, m + 1).Value = "Object Name"
        .Cells(i, m + 2).Value = "Object Texts"
    End With
    
    With thisSheet.Range(Cells(i, m), Cells(i, m + 2))
        .Interior.ColorIndex = 48
        .Font.ColorIndex = 2
        .Font.Bold = True
    End With
    
    For Each sheets In ActiveWorkbook.Worksheets
        If sheets.Shapes.Count > 0 Then
            For Each O In sheets.Shapes
                thisSheet.Cells(i + 1, m).Value = sheets.Name
                thisSheet.Cells(i + 1, m + 1).Value = O.Name
                If O.Name Like "Comment*" Then
                    thisSheet.Cells(i + 1, m + 2).Value = "-"
                Else
                    If O.TextFrame2.HasText Then
                        thisSheet.Cells(i + 1, m + 2).Value = O.TextFrame2.TextRange.Text
                    Else
                        thisSheet.Cells(i + 1, m + 2).Value = "-"
                    End If
                End If
                i = i + 1
            Next O
        End If
    Next sheets

    For n = 1 To 3
        thisSheet.Columns(m).EntireColumn.AutoFit
        m = m + 1
    Next n
    
    Call clearAccelerate
    Exit Sub

Err:
End Sub

• どこにコードをコピーすれば良いのか
• VBAマクロを使用する上での注意点

については下記の記事で詳しく書いているので、そちらを参考にされてください。

この記事もツール紹介の記事ですが、「VBA プログラムの表示」の項目の後に詳しいコピーの仕方や注意点について書いてます。

 
ということで本日は以上になります。

私もまだまだVBA含めプログラミングを学習中の身なので、

「もっとこうした方が効率的に書けるよ！」
「こんな業務効率化したいんだけど、VBAでできるかな？」

など、ご指摘やアイディアなどをいただけると嬉しいです！

また、Excel VBAを独学したい方向けに記事を書きましたので、興味がある方はご参考にされてみてください↓

それでは本日もお読みいただきありがとうございました。

Twitter(@ProgYuki)でも情報発信しているので、ぜひフォロー、いいね、RT等お願いします！

ゆう