■実装するプログラムの概要
任意のシートに配置している図形について、図形の名前とテキストを一覧に出力する。
・イメージ図
「検索対象」シートに設置している図形の名前とテキストを「検索結果」シート「の一覧出力」ボタン押下時に一覧表に出力する。
■フローチャート
■プログラム仕様
| インプット | 処理内容 | アウトプット |
|---|---|---|
| – | シート名をセットする。 「検索結果」シート 「検索対象」シート | – |
| – | 「検索結果」シート初期化処理 ・開始時間（C2セル） ・終了時間（C3セル） ・検索結果一覧表（6行目以降） | – |
| – | 「No.」列出力用の初期値（1）をセットする。 | – |
| – | 行カウンタの初期値（6）をセットする。 ※一覧の結果を6行目から出力するため。 | – |
| – | 検索開始時間を出力する。 | 【セルの値】 「検索結果」シート タイムスタンプ |
| 「検索対象」シートの図形 | 【ループ処理開始】 図形の数だけ繰り返し | – |
| – | 「No.」列に番号を出力する。 | 【セルの値】 「検索結果」シート 1から連番 |
| 「検索対象」シートの図形 | 「図形名」列に図形の名前を出力する。 | 【セルの値】 「検索結果」シート 図形の名前 |
| 「検索対象」シートの図形 | 「テキスト」列に図形に記載したテキストを出力する。 | 【セルの値】 「検索結果」シート テキスト |
| – | 「No.」と「行カウンタ」をインクリメントする。 | – |
| – | 検索終了時間を出力する。 | 【セルの値】 「検索結果」シート タイムスタンプ |
| – | 終了メッセージを出力する。 | 【メッセージボックス】 「終了」 |
| – | シートオブジェクトを解放する。 | – |
■サンプルコード
Option Explicit
' 「図形一覧出力」ボタン押下時の処理
Public Sub Btn_Click_GetShape()
Dim shtname_result As Worksheet ' 「検対結果」シートを格納する変数
Dim shtname_search As Worksheet ' 「検索対象」シートを格納する変数
Dim iNo As Integer ' No.出力カウンタ
Dim irow As Integer ' 行カウンタ
Dim shp As Shape ' 図形オブジェクトを格納する変数
On Error GoTo Btn_Click_GetShape_ERROR
' シート名をセット
Set shtname_result = Sheets("検索結果")
Set shtname_search = Sheets("検索対象")
' 「検索結果」シートの初期化
With shtname_result
.Cells(2, 3).Value = ""
.Cells(3, 3).Value = ""
.Range("6:1048576").ClearContents
End With
' 初期値をセット
' No.出力：1をセット
iNo = 1
' 「検対結果」シート6行目をスタート行とする
irow = 6
' 検索開始時間を出力
shtname_result.Cells(2, 3).Value = Now
' 「検索対象」シートにフォーカス
With shtname_search
' 図形の数だけループ処理
For Each shp In .Shapes
' 「No.」列に番号を付与
shtname_result.Cells(irow, 2).Value = iNo
' 「図形名」列に図形の名前を付与
shtname_result.Cells(irow, 3).Value = shp.Name
' 「テキスト」列に図形に記載したテキストを付与
shtname_result.Cells(irow, 4).Value = shp.TextFrame2.TextRange.Text
' インクリメント処理
iNo = iNo + 1
irow = irow + 1
Next
End With
' 検索終了時間を出力
shtname_result.Cells(3, 3).Value = Now
' 終了メッセージを出力
MsgBox "終了"
' 終了処理へ
GoTo Btn_Click_GetShape_Exit
' エラーハンドリング
Btn_Click_GetShape_ERROR:
' エラーメッセージを出力
MsgBox Err.Description
' 終了処理へ
GoTo Btn_Click_GetShape_Exit
' 終了処理
Btn_Click_GetShape_Exit:
' シートを解放
Set shtname_search = Nothing
Set shtname_result = Nothing
End Sub■実行結果
コメント