VBA基礎２：VBAメソッドおよび自作マクロの紹介

KIYO

2021年12月5日 22:41

概要

　私が普段の業務でExcelによく組み込むVBAを記載していく予定です。なおマクロを作成するときの個人的な注意点は下記の通りです。

【マクロ作成時のメモ】
●できる限りコメントは残そう
●処理が長いコードは必ず終了を連絡する処理を追加
●終了連絡に合わせてできる限り処理時間も出力
●マクロを使う必要がなければできる限りExcel内で処理しよう

１．VBA機能・基礎コード

１－１．変数定義の必須化：Option Explicit

　Excelでは変数を定義しなくても問題なく使用できます。この変数定義を必須化したい定義されていない変数使用時はエラー場合は "Option Explicit"を使用します。

１－２．同じ文字を記載：With/End With

　With/End Withで挟むことで.ピリオドを記載したコードの前はWithの後ろに書いたコードを記載したものとみなすことが出来ます。

With ThisWorkbook.Worksheets("Sheet名")
    flag = .Cells(1, 1).Value 'ThisWorkbook.Worksheets("Sheet名").Cells(1, 1).Valueと同じ
End With

２．ファイル情報取得

　ファイル情報の取得方法を記載します。なお近いことはFSOでも可能です。

２ー１．ファイルディレクトリ取得：ThisWorkbook.Path

　使用しているExcelのファイルディレクトリを取得します。相対的にパスを取得できるためロバストな処理誰のPCでもちゃんと動くができます。

Sub ファイルパス()
    Dim filepath As String
    
    filepath = ThisWorkbook.Path
    Range("A1").Value = "ファイルパス"
    Range("B1").Value = filepath

End Sub

２－２．ファイル名の取得：ThisWorkbook.Name

　ファイルの名前を取得します。ディレクトリとくっつければファイルパスを取得できます。

Sub ファイルパス2()
    Range("C1").Value = ThisWorkbook.Name
End Sub

２－３．Excelの最終行取得：End(xlUp)

　Excelシートの最終行を取得してEnd(xlUp)で値が入ったセルまで移動Ctrl + ↑と同じ動作します。

[In]
Sub 最終行の取得()
    r = ActiveSheet.Rows.Count '使用しているシートの最大行数(1048576)を取得 ※Excel2010
    Debug.Print Cells(r, 2).End(xlUp).Value '最終行から上に移動したときのセルの値
    Debug.Print Cells(r, 2).End(xlUp).Row + 1 'セルがある行の一つ下のセル行数

End Sub

[Out]
Microsoft Excel マクロ有効ワークシート
17

３．ファイル操作

３－１．ファイル・フォルダ作成

　フォルダを作成する場合はMkDirを使用します毎週の会議資料用に使用中。

Sub フォルダ作成()
    Dim foldername As String
    
    foldername = "\関数で作成"
    MkDir ThisWorkbook.Path & foldername

End Sub

３－２．ファイルの保存

追って

Workbooks("Test.xlsx").Save

Workbooks("Test.xlsx").Close
FileCopy ThisWorkbook.FullName, "c:¥temp¥test.xlsm" '開いているファイルの保存不可

４．セルの処理

４－１．セルの処理：メソッド（Copy, Clear）

　セルを操作する処理がメソッドです。下記はコピペ用コードであり、A1セルをコピーしてC4セルに張り付けます。

Sub コピーandペースト()
    
    Cells(1, 1).Copy '範囲を選択してメソッドをつける
    Range("C4").PasteSpecial Paste:=xlPasteValues '形式を選択して貼り付け

End Sub

　またCell.Clearにすると数式・書式などすべてクリアにできます。

[In]
Cells(1, 1).Clear

５．関数

５－１．本日の日付：Format(Date, 表示形式)

　本日の日付を文字列で取得します。ファイル名に使用でき、よく6桁表示を使っているのでコードは下記となります。

Sub 今日の日付()
    Dim Todaydate As String
    Todaydate = Format(Date, "yymmdd") '6桁表記
    Range("A2").Value = "本日の日付"
    Range("B2").Value = Todaydate
End Sub

なおSubプロシージャ―戻り値がない処理でなくFunctionプロシージャ―戻り値がある処理にすればセル内やモジュール内VBAを書くところでも使用可能です。

Function todaystring()
   todaystring = Format(Date, "yymmdd") '6桁表記
End Function

５－２．文字列の置換：Replace

　文字列を置換します。下記はファイルパスの文字列を取得して、.xlsmExcelの拡張子を.pdfに変換しています。

Sub 文字列の置換()
    Dim filepath_excel, filepath_pdf As String
    
    filepath_excel = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    filepath_pdf = Replace(filepath_excel, "xlsm", "pdf")
    
    Range("A4").Value = filepath_excel
    Range("B4").Value = filepath_pdf
    
End Sub

６．メッセージ／表示・体裁

６－１．処理時間の出力：Timer

　処理コードの時間を計測したい場合はTimer関数を使用します。

[In]
Sub 時間計測()

'処理時間取得用
    Dim startTime As Double
    Dim endTime As Double
    Dim processTime As Double
    
    '開始時間取得ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
    startTime = Timer
    
    '処理を記載
    x = 0
    For i = 1 To 3000
        x = x ^ 2
        Debug.Print x
    Next
    
    '終了時間取得ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
    endTime = Timer
    '処理時間表示
    processTime = endTime - startTime
    MsgBox "データ処理が完了しました。" & Chr(10) & "処理時間：" & Round(processTime, 1) & "sec"

End Sub

６－２．表示／非表示：.Hidden=Bool

　行や列の範囲を指定することで表示／非表示が切り替えできます。

[In]
Rows("1:3").Hidden = True '指定行を非表示にする。
Rows("1:3").Hidden = False '指定行を表示にする。
Columns("A:C").Hidden = True '指定列を非表示にする。
Columns("A:C").Hidden = False '指定列を表示にする。

　また特定のセルを使うことで特定行の切り替えをすることが出来ます。例として同じファイル内で別の体裁を使用したい国内案件と海外案件を共通で使用場合に使っています。

Sub 表示する行の切り替え()

    row_close1 = 2 '切り替えたい行1の開始行
    row_close2 = 6  '切り替えたい行2の開始行
    
    flag = Cells(1, 1).Value 'A1
    openword = "Pattern1"
    closeword = "Pattern2"
    
    If flag = openword Then
        Rows(row_close1 & ":" & row_close1 + 3).Hidden = True '2-5行目を非表示
        Rows(row_close2 & ":" & row_close2 + 2).Hidden = False '6-8行目を表示
        Cells(1, 1).Value = closeword
        MsgBox "Pattern2に切り替えました。"
    Else
        Rows(row_close1 & ":" & row_close1 + 3).Hidden = False '2-5行目を表示
        Rows(row_close2 & ":" & row_close2 + 2).Hidden = True '6-8行目を非表示
        Cells(1, 1).Value = openword
        MsgBox "Pattern1に切り替えました。"
    End If
       
End Sub

７．PDF化

７－１．Excel-VBAでPDF化

　ファイルをPDF化します。F12でもよいですが名前を付けて保存のショートカット、シートの指定などある場合はマクロを組む方が楽です。

Sub PDF化()
    Set Sheet = ThisWorkbook.Sheets("Sheet1") 'Sheetオブジェクトを定義
    today = todaystring() '上記のFunction：todaystring()を呼び出し
    
    Sheet.ExportAsFixedFormat Type:=xlTypePDF _
    , Filename:=ThisWorkbook.Path & "\" & today & "_note.pdf" _
    , OpenAfterPublish:=True 'PDF化後にPDFファイルを開く

End Sub

７－２．プリンターでの印刷自動化

　VBAのPDFでできないこと(PDF化時のページ幅を統一化)はPDFプリンター「Microsoft Print to PDFなど」を使用して印刷経由でPDF化します。

８．図形作成

　マクロを使用して図形を作成します。

８－１．電子印の作成

　海外では1mmも役に立ちませんが今の会社で「会社では用意してないけど今日の日付付きの電子印押してね」と言われたので作りました。
　作り方はChatGPT君と協力しながら作ってみました。処理の大きな流れは下記の通りです。

電子印の外径、色、文字サイズを指定
電子印の位置を指定※文字や線のバランスをとるためこれらは固定値として適当な値を選定
必要なパーツに条件を設定して追加（円、テキストボックス×3、線×２）
全てのパーツをグループ化

　注意点として外径のサイズと位置に合わせて文字の位置・サイズ、線の太さ・長さを職人芸で調整しているため電子印のサイズを変更する場合は都度調整が必要です。

[IN]
Sub CreateStamp()
    Dim num_Fontsize As Integer
    Dim color_stamp As Variant
    Dim num_lineW As Integer

    num_Fontsize = 10 'フォントサイズ
    color_stamp = RGB(255, 0, 0) '電子印の色:赤
    num_lineW = 1 '電子印の線の太さ

    ' 図形のサイズを指定
    Dim stampSize As Integer
    stampSize = 55 '電子印の円の外径を指定

    ' セルの位置を指定
    Dim stampLeft As Integer
    Dim stampTop As Integer
    stampLeft = 55 '電子印の左上のX座標を指定
    stampTop = 55 '電子印の左上のY座標を指定


    ' 部門名と氏名を指定
    Dim deptName As String
    Dim signName As String

    deptName = "note" '部門名を指定
    signName = "KIYO" '氏名を指定

    ' 現在の日付を取得
    Dim todayDate As Date
    todayDate = Date

    ' 円を追加
    Dim stamp As Shape
    Set stamp = ActiveSheet.Shapes.AddShape(msoShapeOval, stampLeft, stampTop, stampSize, stampSize)
    stamp.Line.Visible = msoTrue ' 円の線を表示する
    stamp.Line.Weight = num_lineW ' 円の線の太さ
    stamp.Line.ForeColor.RGB = color_stamp ' 円の線の色
    stamp.Fill.ForeColor.RGB = RGB(255, 255, 255) ' 円の塗りつぶしの色を白に指定

    ' テキストボックス(部門名)を追加
    Dim deptTop As Integer
    deptTop = stampTop + stampSize / 2 '円の半径と文字の間隔を指定

    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, stampLeft, deptTop - 24, stampSize, stampSize / 2) '(左上のX座標, 左上のY座標, 幅, 高さ)
        .TextFrame.Characters.Text = deptName 'テキストボックスに部門名を追加
        .TextFrame.HorizontalAlignment = xlHAlignCenter 'テキストボックスの中央揃え
        .Line.Visible = msoFalse ' 枠線を非表示にする
        .TextFrame.Characters.Font.Size = num_Fontsize ' テキストサイズ
        .TextFrame.Characters.Font.Color = color_stamp ' テキストの色
        .Fill.Visible = msoFalse ' 塗りつぶしを非表示にする
    End With


    ' 氏名を追加
    Dim signTop As Integer
    signTop = stampTop + stampSize / 2 ' 円の半径と文字の間隔を指定
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, stampLeft, signTop + 9, stampSize, stampSize / 2)
        .TextFrame.Characters.Text = signName 'テキストボックスに氏名を追加
        .TextFrame.HorizontalAlignment = xlHAlignCenter 'テキストボックスの中央揃え
        .Line.Visible = msoFalse ' 枠線を非表示にする
        .TextFrame.Characters.Font.Size = num_Fontsize ' テキストサイズ
        .TextFrame.Characters.Font.Color = color_stamp ' テキストの色
        .Fill.Visible = msoFalse ' 塗りつぶしを非表示にする
    End With


    ' 日付のテキストボックスを追加
    Dim dateBox As Shape
    Set dateBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                                stampLeft - 3, _
                                                stampTop + stampSize / 3, _
                                                stampSize, _
                                                stampSize)

    dateBox.TextFrame.Characters.Text = Format(todayDate, "yyyy/mm/dd") 'Format関数で日付を指定の形式に変換
    dateBox.TextFrame.HorizontalAlignment = xlHAlignCenter 'テキストボックスの中央揃え
    dateBox.Line.Visible = msoFalse ' 枠線を非表示にする
    dateBox.TextFrame.Characters.Font.Size = num_Fontsize ' テキストサイズ
    dateBox.TextFrame.Characters.Font.Color = color_stamp ' テキストの色
    dateBox.Fill.Visible = msoFalse ' 塗りつぶしを非表示にする
    dateBox.Width = stampSize + 10 ' 日付のテキストボックスの幅を広げる

    ' 日付の上下に赤線を引く
    Dim line_top As Shape
    Dim line_bottom As Shape

    '上部
    Set line_top = ActiveSheet.Shapes.AddLine(stampLeft, _
                                            stampTop + stampSize / 3, _
                                            stampLeft + stampSize, _
                                            stampTop + stampSize / 3)
    line_top.Line.ForeColor.RGB = color_stamp
    line_top.Line.Weight = num_lineW
    '下部
    Set line_bottom = ActiveSheet.Shapes.AddLine(stampLeft, _
                                            stampTop + stampSize / 1.5, _
                                            stampLeft + stampSize, _
                                            stampTop + stampSize / 1.5)
    line_bottom.Line.ForeColor.RGB = color_stamp
    line_bottom.Line.Weight = 1

    ' 円とテキストをグループ化
    Dim stampGroup As Shape
    Set stampGroup = ActiveSheet.Shapes.Range(Array(stamp.Name, _
                                            ActiveSheet.Shapes(ActiveSheet.Shapes.Count - 4).Name, _
                                            ActiveSheet.Shapes(ActiveSheet.Shapes.Count - 3).Name, _
                                            ActiveSheet.Shapes(ActiveSheet.Shapes.Count - 2).Name, _
                                            ActiveSheet.Shapes(ActiveSheet.Shapes.Count - 1).Name, _
                                            ActiveSheet.Shapes(ActiveSheet.Shapes.Count - 0).Name)).Group

    stampGroup.Line.Visible = msoFalse ' グループ内の線を非表示にする
    stampGroup.Fill.ForeColor.RGB = RGB(255, 255, 255) ' グループ内の塗り

End Sub

[OUT]

【メモ：XVBAでの作成時の注意点】
　VBEは苦手なのでXVBAで作成しましたが、XVBAからマクロを実行すると「オブジェクト変数またはWithブロック変数が設定されていない」というエラーが解消できませんでした。
　原因としてはXVBAではなぜかシートが非表示になるため”Activesheet”が認識されず出力できないことが原因でした。
　XVBAの結果をExcelにExport後にシートを表示して実行したらエラーは解消できました。

参考資料・参考記事

●本の感想一覧

　自分が読んだ本の感想記載

●Excelショートカット@Excel医@デザイン勉強中

「Excelショートカットキーの一覧が欲しい！」

どれがいいかわからんから、今まで作ったのいい感じに使ってくれ。

Excelショートカットキーまとめhttps://t.co/0dUlCTGuoa pic.twitter.com/2qF9khWu0g
— Excel医@デザイン勉強中 (@Excel_design_Dr) December 5, 2021

【VBA】Outlookから添付ファイルを付けてメールを送付

あとがき

　構成も含めてどんどん追加・修正予定
->outlookでのメール処理は今後記載