【VBA】使えそうなExcelマクロ(シート名一覧・コメント一覧・図形内テキスト一覧の取得)
マクロ用ブックとして、手元に置いとけば使えそうな(現に自分は置いている)マクロの紹介です。
シート名一覧取得
まずは、サンプルコード。
Sub GetSheetName()
Dim WrkSht As Worksheet
Dim RowIdx As Integer
For Each WrkSht In Worksheets
RowIdx = RowIdx + 1
Cells(RowIdx, 1) = WrkSht.Name
Next
End Sub
これはシート単位でループして名前をセルに書き出しているだけ。
またワークシートのVisibleプロパティでシートの表示状態を取得して、表示されているシートのみ、と言う条件も加えられます。
また、設定可能な値は、以下の3つ。
表示のみとするなら、こんな感じです。
If WrkSht.Visible == xlSheetVisible Then
Cells(RowIdx, 1) = WrkSht.Name
End If
コメント一覧取得
これも、シート内のコメントはActiveSheet.Commentsなのでループして値を取得するだけ。
Public Sub GetAllComments()
Dim WrkCmt As Comment
Dim RowIdx As Integer
For Each WrkCmt In ActiveSheet.Comments
RowIdx = RowIdx + 1
Cells(RowIdx, 1) = WrkCmt.Text
Next WrkCmt
End Sub
図形内テキスト一覧取得
セルに対して付ける「コメント」ではなく、吹き出しなどの矩形を使ってコメントを書く人も多いかと思います。
その場合のVBAコードです。
Sub GetAllShapeText()
Dim WrkShp As Shape
Dim WrkText As String
Dim RowIdx As Integer
For Each WrkShp In ActiveSheet.Shapes
WrkText = ""
'吹き出し図形のみ対象
If WrkShp.AutoShapeType >= msoShapeRectangularCallout _
And WrkShp.AutoShapeType <= msoShapeLineCallout4BorderandAccentBar Then
'Excelのバージョン判定
If Application.Version >= 12 Then
If WrkShp.TextFrame2.HasText = True Then
WrkText = WrkShp.TextFrame2.TextRange.Text
End If
Else
If WrkShp.AlternativeText <> "" Then
WrkText = WrkShp.AlternativeText
End If
End If
End If
If WrkText <> "" Then
RowIdx = RowIdx + 1
Cells(RowIdx, 1) = WrkText
End If
Next
End Sub
ポイントとしては、コメントとして扱いたくないテキスト入りの図形があることを想定して、図形のタイプを「吹き出し」関係の範囲内に限定しています。
(不要の場合は、条件を削除してください)
また、Excel2007以降は機能拡張に伴って、テキストが設定されるプロパティが変更されているため、バージョンで分岐するようにしています。