0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

VBAの特殊なデータ型(列挙体をデータ型として利用する)

Last updated at Posted at 2024-09-29

VBAのデータ型

VBAにもデータ型があります。

VBA
Dim userName As String
Dim i As Long
Dim dueDate As Date
Dim fileExists As Boolean

基本はデータ型を明示するべきで、Variant型は原則使用しないことをお勧めします。

なお、あまりよく知られていないのですが、データ型にはVBAで用意されている組み込み定数(列挙体)もデータ型として利用することが可能です。

VBAの列挙体をデータ型として利用する

組み込み定数の例としては、MsgBox関数の戻り値のVbMsgBoxResult列挙型等があります。

VbMsgBoxResult列挙型
定数	   
vbOK       1
vbCancel   2
vbAbort	   3
vbRetry	   4
vbIgnore   5
vbYes	   6
vbNo	   7

MsgBox関数の戻り値は上記になりますので、戻り値に応じて処理を分岐させることができます。例えば下記のコードでは、データ加工する際に罫線をつけるかを変数bordersFlgをVbMsgBoxResult型で宣言することによって、コード入力時にインテリセンスが効くので便利です。
戻り値はこの場合に1~6になりますので、Long型やInteger型でもよいのですが、この場合はインテリセンスが効きません。

コード
ExcelVBA
Sub sbデータ整形()
'オートフィルター&列幅調整&見出し以外にデータがない列をグループ化&ウィンドウ枠の固定
  
    Dim headerRow    As Variant '見出し行数をInputBoxで入力するための変数
    Dim j            As Long    '列カウンター
    Dim lastColomns  As Long
    Dim bordersFlg   As VbMsgBoxResult    '罫線はつけるかのフラグ
 
    Application.ScreenUpdating = False                  '画面更新の停止
   
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.ActiveSheet 'ActiveSheetをwsに設定
  
    With ws
           
        headerRow = Application.InputBox( _
               PROMPT:="見出し行数を入力してください。" & vbCrLf & "(1未満の数値を入力した場合は、1として扱います。)", _
               TITLE:="見出し行数入力", _
               Type:=1)
        If TypeName(headerRow) = "Boolean" Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        '入力された数値が整数か判定(小数点があるならマクロ実行キャンセル)
        If Int(headerRow) <> headerRow Then
            MsgBox "入力された数値が小数点であるためマクロ実行をキャンセルします"
            Exit Sub
        End If
       
        If TypeName(headerRow) = "Boolean" Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        '罫線をつけるかどうかの選択肢:はい、いいえ、キャンセル
        bordersFlg = MsgBox( _
               PROMPT:="罫線を設定しますか?", _
               TITLE:="罫線設定の有無", _
               Buttons:=vbYesNoCancel)
              
        If bordersFlg = vbCancel Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        If headerRow < 1 Then headerRow = 1 '入力された見出し行数が1未満の場合のみ見出し行数を1として取り扱う
        On Error Resume Next '一時的なエラー無効化(テーブルに対して下記コード実行するとエラーとなるためエラー無効化
        If .AutoFilterMode = False Then
          'オートフィルターが設定されていないならオートフィルターを設定
          .Range("A" & headerRow).EntireRow.Select
          Selection.AutoFilter
        End If
        On Error GoTo 0  'On Errorの無効化
       
        If bordersFlg = vbYes Then '罫線設定するが「はい」なら下記を実行
          .Range("A" & headerRow).CurrentRegion.Borders.LineStyle = xlContinuous
        End If
       
        lastColomns = .Cells(headerRow, Columns.count).End(xlToLeft).Column
        .Range(Columns(1), Columns(lastColomns)).EntireColumn.AutoFit    '列幅を自動調整
        .Range(Columns(1), Columns(lastColomns)).ColumnWidth = Range(Columns(1), Columns(lastColomns)).ColumnWidth + 2 '列幅に余裕を持たせる
          
        For j = lastColomns To 1 Step -1
          If Application.WorksheetFunction.CountA(.Columns(j)) <= 1 Then 'ヘッダなしも含めて1未満
             On Error Resume Next  '一時的なエラー無効化
             '何度もこのマクロ実行すると同じ列のグループ化階層が深くなるため、事前に一度グループ化解除(グループ化していない列を解除するとエラーとなるためエラー無効化)
              .Columns(j).Ungroup
             On Error GoTo 0  'On Errorの無効化
              .Columns(j).Group 'グループ化
             'Debug.Print j '一時確認用
          End If
        Next j
      
     End With
  
    ws.Outline.ShowLevels ColumnLevels:=1
    Range("A" & headerRow + 1).Select
    ActiveWindow.FreezePanes = True  '見出し行の下でウィンドウ枠の固定
    
    Application.ScreenUpdating = True                   '画面更新の開始
    MsgBox "処理が終了しました。", , "処理結果通知"
   
End Sub

Long型ではなく、VbMsgBoxResult型にすることでコード入力中にインテリセンスが効く。

スクリーンショット 2024-10-14 213132.png

他にも列挙型はたくさんありますが、例えば図形(オートシェイプ)の形状を示すMsoAutoShapeType型があります。
Microsoft公式:MsoAutoShapeType 列挙 (Office)

コード
ExcelVBA
Sub sb赤枠四角図形挿入()
   Application.ScreenUpdating = False
       Call sb赤枠透明図形挿入(msoShapeRectangle)    '図形形状:角が丸い四角
   Application.ScreenUpdating = True
End Sub
 
Sub sb赤枠楕円図形挿入()
   Application.ScreenUpdating = False
       Call sb赤枠透明図形挿入(msoShapeOval)  '図形形状:楕円
   Application.ScreenUpdating = True
End Sub
 
Public Sub sb赤枠透明図形挿入(図形形状 As MsoAutoShapeType)
'マニュアル作成作業でよく使用する赤枠・背景透明の図形を挿入する(図形の種類は引数で指定)
   With ActiveCell
        ActiveSheet.Shapes.AddShape _
             (Type:=図形形状, _
              Left:=.Left, Top:=.Top, Width:=200, Height:=125).Select
   End With
   Selection.ShapeRange.Fill.Visible = msoFalse
   With Selection.ShapeRange.line
         .Visible = msoTrue
         .ForeColor.RGB = RGB(255, 0, 0)
         .Weight = 5  '太さ
         .Transparency = 0.3  '透明度
    End With
End Sub

このようにデータ型としてVBAの組み込み定数(列挙体)を使用することで、Subプロシージャ等を呼び出す際に、引数についてインテリセンスが働き、コードの作成が速くなります。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?