1. はじめに
どうも、趣味でデータ分析している猫背なエンジニアです。
本日もAdvent Calendar 2025の記事を書いていきます！
前回の記事ではマクロのセットアップについて書きましたが、
今回は実践編と題して書いていきたいと思います。
2. マクロの作成事例
本記事では、業務で使いやすいようにボタンでマクロを起動する方法を説明します。私もよくこの方法で業務効率化をしているので、参考にしてみてください。
■ ボタン操作の事前準備
1．開発タブ → 挿入 → ボタン（フォーム）
2．任意の位置に配置
3．実行するマクロを紐づける
4．これだけで「1クリックExcel」が完成します。
説明としてはこんな感じで書いていますが、簡単に言うと
「好きなボタンを挿入して、右クリックして"マクロの登録"でマクロを作る」という感じです。
■ ボタン操作（フォームコントロール）の例
以下にボタンを使用した例を書いています。
実際に実行するとメッセージボックスに"ボタンがクリックされました！"と表示されます
Sub ButtonClickSample()
MsgBox "ボタンがクリックされました！"
End Sub
■ シートの一覧を取得してメッセージで表示
ブック内に存在するシートをメッセージボックスで表示してくれます。
仕様書や設計書など、いっぱいシートがある際にどんなドキュメントがあるか確認したいときに使えます。
Sub ShowSheetList()
Dim s As Worksheet
Dim list As String
For Each s In ThisWorkbook.Worksheets
list = list & s.Name & vbCrLf
Next s
MsgBox list
End Sub
■ シートを指定して、コピーを作成&日付入りで保存する
以下のソースコードはブック内のシートを選択してReport_日付でコピーしてくれる機能になっています。
Sub CopySheetWithDate_Popup()
Dim targetSheet As String
Dim newName As String
' ポップアップでシート名を入力
targetSheet = InputBox("コピーしたいシート名を入力してください", "シート選択")
' キャンセル・空白対応
If targetSheet = "" Then
MsgBox "シート名が入力されませんでした。処理を中断します。"
Exit Sub
End If
' シートが存在するかチェック
On Error Resume Next
Worksheets(targetSheet).Activate
If Err.Number <> 0 Then
MsgBox "指定されたシート """ & targetSheet & """ は存在しません。"
Exit Sub
End If
On Error GoTo 0
' 新しいシート名
newName = "Report_" & Format(Date, "yyyymmdd")
' シートコピー処理
Sheets(targetSheet).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = newName
MsgBox "シート """ & targetSheet & """ をコピーし、" & newName & " として作成しました！"
End Sub
■ フォルダ内のExcelを全部読み込んで集計
指定のフォルダ内にあるExcelシートをすべて読み込んで、Summaryというシートに集計するマクロ。
今回は以下の表をサンプルに集計するようにしています。
実際にはその場にあったマクロに変更してください。
Sub ImportFromFolder_Dialog()
Dim fd As FileDialog
Dim folderPath As String
Dim f As String
Dim wb As Workbook
Dim lastRow As Long
Dim pasteRow As Long
' --- フォルダ選択ダイアログ ---
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Excelファイルが入ったフォルダを選択してください"
If fd.Show <> -1 Then
MsgBox "フォルダが選択されませんでした。"
Exit Sub
End If
folderPath = fd.SelectedItems(1) & "\"
' --- フォルダ内の XLSX を取得 ---
f = Dir(folderPath & "*.xlsx")
pasteRow = 2
Do While f <> ""
' --- ファイルを開く ---
Set wb = Workbooks.Open(folderPath & f)
' --- 最終行を取得 ---
lastRow = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
' --- A2:C 最終行 を Summary に貼り付け ---
wb.Sheets(1).Range("A2:C" & lastRow).Copy _
ThisWorkbook.Sheets("Summary").Range("A" & pasteRow)
pasteRow = pasteRow + (lastRow - 1)
wb.Close SaveChanges:=False
f = Dir
Loop
MsgBox "インポートが完了しました！"
End Sub
■ 指定シートをPDFに出力
Sub ExportToPDF_Popup()
Dim targetSheetName As String
Dim targetSheet As Worksheet
Dim path As String
'▼ シート名をポップアップで指定
targetSheetName = Application.InputBox( _
Prompt:="PDF出力するシート名を入力してください。" & vbCrLf & _
"（例：Report、Sheet1 など）", _
Title:="シート選択", _
Type:=2) 'Type:=2 は文字列入力
'キャンセル時
If targetSheetName = "False" Then
MsgBox "処理をキャンセルしました。"
Exit Sub
End If
'▼ 指定したシートが存在するか確認
On Error Resume Next
Set targetSheet = ThisWorkbook.Sheets(targetSheetName)
On Error GoTo 0
If targetSheet Is Nothing Then
MsgBox "指定されたシートが存在しません。"
Exit Sub
End If
'▼ 保存先の PDF パス作成
path = ThisWorkbook.Path & "\" & targetSheetName & "_" & Format(Date, "yyyymmdd") & ".pdf"
'▼ PDF 出力
targetSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=path
MsgBox "PDF を出力しました：" & vbCrLf & path
End Sub
■ Excelからメールを送る（Outlook classic使用）
送信も自動で実施できる。
実際の現場ではこれで書類を作って送信まで自動化できる
Sub SendMail()
Dim ol As Object
Dim mail As Object
Set ol = CreateObject("Outlook.Application")
Set mail = ol.CreateItem(0)
With mail
.To = "XXXXXXXXXXXXX@outlook.com"
.Subject = "今日のレポート"
.Body = "レポートを添付します。"
.Attachments.Add ThisWorkbook.Path & "\Summary.pdf"
.Send
End With
End Sub
7. おわりに
VBAで業務系をするためのサンプルを列記していきました。残念ながらOutlookはClassicしか動かないことがわかり残念でした。
Googleも連携できるみたいですので、個人で使用する場合はGoogleを推奨します。
あ～残念だ...。