WP Demo

作成日 :

1-1.日付から該当する第何曜日のシートを抽出

入力された日付から「第何週・何曜日」であるかを自動判定し、該当する日誌フォーマットを展開するExcelファイルを構築する。

全体フロー

  1. 雛形（テンプレート）シートの準備
  2. 日付入力用シートの作成
  3. マクロ（VBA）の実装
  4. 実行ボタンの配置
  5. テンプレートファイル（.xltm）として保存

製作手順

1. 雛形（テンプレート）シートの準備

日誌のベースとなるExcelファイルを新規作成し、各曜日・各週のフォーマットとなるシートを用意する。

  1. 新規Excelブックを作成
  2. 必要な数だけシートを追加し、それぞれに日誌のフォーマットを作成
  3. 【重要】各シートの名前を以下の規則に従って正確に変更
    　曜日1文字」＋「第何週の数字」（例：「月1」「月2」…「金5」など）
    　※マクロはシート名を「完全一致」で検索するため、スペースなどは入れない

2. 日付入力用シートの作成

操作の起点となる「日付入力」専用のシートを作成

  1. ブックの先頭に新しいシートを追加し、シート名を 「日付入力」 とする
  2. 操作者が分かりやすいようにレイアウトを整える
    例：セル `A2` に「作成する日誌の日付を入力：」と記載
    例：セル `B2` を「日付入力欄」として背景色をつける、罫線で囲むなど
  3. セル `B2` の表示形式を「短い日付形式」などに設定する

3. マクロ（VBA）の実装

裏側で動作する自動処理（マクロ）のプログラムを組み込む

  1. Excel上で `Alt` キーを押しながら `F11` キーを押し、VBAエディタを起動
  2. 上部メニューの [挿入] ＞ [標準モジュール] をクリック
  3. 左側のプロジェクトツリーに追加された「Module1」をダブルクリックし、右側の白い画面に以下のコードをすべてコピー＆ペースト

4. 実行ボタンの配置

日付入力シートからマクロを手軽に実行可能にする

  1. [挿入] ＞ [図形] などから好みのボタン用図形を配置
  2. 図形を右クリックし [マクロの登録] を選択
  3. 「CreateDailyReport」を選択して決定

5. テンプレートファイル（.xltm）として保存

毎回フォーマットが上書きされないよう、テンプレートとして保存

  1. [ファイル] ＞ [名前を付けて保存] を選択
  2. ファイルの種類で「Excel マクロ有効テンプレート (*.xltm)」を選択
  3. 適切な名前を付けて保存する
' 日付から第何曜日のシートを抽出するマクロ
Sub CreateDailyReport()
  Dim targetDate As Date
  Dim nthWeek As Integer
  Dim dowString As String
  Dim targetSheetName As String
  Dim wsInput As Worksheet
  Dim d As Date 🔸
  Dim count As Integer 🔸
  
  ' 日付入力シートの名前を指定
  Set wsInput = ThisWorkbook.Sheets("日付入力")
  
  ' B2セルに日付が入力されているか確認
  If Not IsDate(wsInput.Range("B2").Value) Then
    MsgBox "有効な日付を入力してください。", vbExclamation
    Exit Sub
  End If
  
  targetDate = wsInput.Range("B2").Value
  
  ' 曜日を取得 (月, 火, 水, 木, 金, 土, 日)
  dowString = Format(targetDate, "aaa")
  
  ' その月におけるその曜日の何回目かを正確に計算する処理 🔸追加
  d = DateSerial(Year(targetDate), Month(targetDate), 1)
  count = 0
  Do While d <= targetDate
    If Weekday(d) = Weekday(targetDate) Then
      count = count + 1
    End If
    d = d + 1
  Loop
  nthWeek = count
  
  ' 探すべきシート名を生成（例："月1", "火3" など）
  targetSheetName = dowString & nthWeek
  
  ' 該当するシートが存在するか確認し、新規ファイルとしてコピー
  On Error Resume Next
  ThisWorkbook.Sheets(targetSheetName).Copy
  On Error GoTo 0
  
  ' シートが見つからなかった場合のエラーハンドリング
  If ActiveWorkbook.Name = ThisWorkbook.Name Then
    MsgBox "該当するシート（" & targetSheetName & "）が見つかりません。シート名を確認してください。", vbCritical
  Else
    MsgBox targetSheetName & " の日誌を作成しました。", vbInformation
  End If
End Sub
COPY