【EXCEL：VBA】指定した年月の予定表を作成したい

この記事では、EXCELで年月ごとの予定表を作成する方法について説明します。

予定表にはいろいろな形式がありますが、今回は以下の要素を持った予定表を作成します。

予定作業を入力できるセル
開始日、終了日を9999/99/99形式で入力できるセル
指定した年月の1日から月末日までのカレンダーを表示
カレンダーは、土曜日・日曜日・祝日が色でわかるように表示
各予定をいつからいつまでやるか、ひと目でわかるようにカレンダーに図を貼れるようにする
指定した年月毎にシートをわけて、予定表を作成

それでは、EXCELで簡単に予定表を作成していきましょう。

困っている女性

毎月予定表を作らないといけないのだけど、正直めんどくさいですよ。楽する方法がないかな！？

VBAを使えば、年月を指定してボタンポチッで、作成できますよ。

解決する男性

困っている女性

それそれ、早く教えてよ。

それでは、今回作成する予定表作成ツールの完成画面を説明します。

１．今回作成する予定表作成ツールの説明

予定表作成ツールは、年・月・予定行数を指定して対象の予定表を作成します。

また、予定表のカレンダーに祝日がわかるように色をつけるため、祝日一覧を登録できるようにしています。

予定表作成ツールの実行画面

予定表作成ツール実行画面

祝日一覧には、年月日と祝日名を記入できるようにしています。

祝日名はツールとしては利用しませんが、後で見たときになんの日かわかるように祝日名欄を設けています。

祝日一覧には、個人的な年休取得日や会社の特別な休日も追加することができます。

予定表作成ボタンを押すと、指定されている年月のシートを新規作成し、予定表を作成します。

もちろん、シート名は指定された年月（例：202007）で作成します。

それでは、年に2020、月に7、予定行数に10を指定されたときに作成される「予定表シート」を見てみましょう。

指定された年月（2020年7月）の予定表シート

予定表シート例

わかりやすくするために、予定作業No.1と2を入力しています。

実際には、空の行を作成します。

また、右のカレンダーには予定の開始日から終了日までの図形を貼り付けています。

実際には、このカレンダーには利用者が手で図形や文字を入力して利用します。

予定行数で10を指定した場合、No.10までの予定入力業を作成します。

祝日は、日曜日と同じ色でセルに色をつけます。

祝日一覧には、2020年7月23日と24日が入力されていました。

したがって、2020年7月の予定表カレンダーの23日と24日は、日曜日と同じ色でセルに色がつけられます。

それでは、「予定表を作成するツール」の作り方を、順番に説明していきます。

２．予定表作成実行画面（ツールシート）の作成方法

ツールシート画面の各セルとボタン配置していきましょう。

年・月・予定行数を入力するセルを準備する

年・月・予定行数入力欄

「ツール」という名前のシートを作成します。
A1セルからC1セルを結合して、「予定表作成ツール」と入力します。
A3セルに「年」、B3セルに「月」、C3セルに「予定行数」と入力して、背景色をつけます。
A3セルからC4セルまでを罫線で囲います。

予定表作成ボタンを配置する

ボタンを挿入する

「開発」タブの「挿入」を押して、「ボタン（フォームコントロール）」を押します。

予定表作成ボタンを配置

予定行数入力セルの下にボタンを配置します。

マクロの登録画面

マクロの登録画面が表示されます。
「新規作成」ボタンを押します。

Microsoft Visual Basic for Applications画面

「Microsoft Visual Basic for Applications」画面が立ちがります。
左上の「保存」ボタンを押します。
「予定表作成ツール.xlsm」という名前で保存します。

ボタンの書式設定

「ツール」シートの先程配置したボタンを右クリックします。
「コントロールの書式設定」を押します。

ボタンの書式設定その２

スタイルを「ボールド」、色を「赤」を選択します。
「OK」ボタンを押します。

ボタンのテキスト編集

ボタンを右クリックして、「テキストの編集」を押します。
「予定表作成」と入力します。

予定表作成ボタンの完成

これで、「予定表作成」ボタンの配置は完了です。

祝日一覧を入力するセルを準備する

次に、予定表のカレンダーで祝日を判断するために、祝日一覧を入力するセルを準備します。

祝日入力欄の準備

A7セルとB7セルを結合して、「祝日一覧」と入力します。
A8セルに「日付」とB8セルに「祝日名」と入力します。
A7セルからB8セルの背景色をつけます。
A7セルからB30セルくらいまで罫線を引きます。
祝日を入力しておきます。

３．予定表を作成するVBAプログラムを入力する

それでは、実際に指定された年月で予定表を作成するVBAプログラムを記入していきます。

「開発」タブの「Visual Basic」をクリックして、「Microsoft Visual Basic for Application」を起動します。

VBAを起動する

「予定表作成ボタン」クリック処理のVBAプログラム説明

「予定表作成ボタン」を追加したときに、作成された「Sub ボタン1_Click()」に書くVBAプログラムを説明します。

予定表作成ボタンクリック処理のVBAプログラム

それでは、VBAプログラムを１つ１つ説明していきます。

(1)ツールシートを取得する

'「予定表作成ボタン」クリック処理
Sub ボタン1_Click()
    Dim toolSht As Worksheet
    Dim strYYYYMM As String
    Dim iYoteiGyo As Integer
    
    '(1)ツールシートを取得する
    Set toolSht = ThisWorkbook.Sheets("ツール")

'「予定表作成ボタン」クリック処理

Sub ボタン1_Click()

Dim toolSht As Worksheet

Dim strYYYYMM As String

Dim iYoteiGyo As Integer

'(1)ツールシートを取得する

Set toolSht = ThisWorkbook.Sheets("ツール")

ここでは、「ツール」という名前のシートを変数「toolSht」に格納しています。

「ツール」という名前のシート

なぜ変数に格納するかというと、このあとのプログラムで何度も利用するからです。

毎回、「ThisWorkbook.Sheets(“ツール”)」と書いてしまうと、プログラムが長くなるからです。

また、シート名「ツール」を変えたくなった場合に、この1ヶ所を変更するだけで良いからです。

複数ヶ所で「ツール」という文字を書いてしまうと、書いたヶ所を全て変更する必要があるからです。

(2)対象年月を取得する

 　　'(2)対象年月を取得する
    strYYYYMM = toolSht.Range("A4") & Format(toolSht.Range("B4"), "00")

1 2	'(2)対象年月を取得する strYYYYMM = toolSht.Range("A4") & Format(toolSht.Range("B4"), "00")

ここでは、「ツール」シートのA4セルの値（年）とB4セルの値（月）を取得します。

また、月の値が1桁の可能性があるので、Format関数を利用して強制的に2桁に変換しています。

例えば、1の場合は「01」、2の場合は「02」に変換されます。

もちろん、もともと2桁の値の場合は、そのままです。

例えば、10の場合は「10」、11の場合は「11」のままです。

対象年月の値を取得する

そして、年月の値を年4桁＋月2桁の文字列として、変数「strYYYYMM」に格納します。

例えば、2020年7月が入力されていた場合、「202007」が変数「strYYYYMM」に格納されます。

(3)シートが存在するかチェックする

　　'(3)シートが存在するかチェックする
    If IsExistSheet(strYYYYMM) Then
        MsgBox "すでに【 " & strYYYYMM & " 】シートは存在します。", vbExclamation, "予定表作成"
        Exit Sub
    End If

　　'(3)シートが存在するかチェックする

If IsExistSheet(strYYYYMM) Then

MsgBox "すでに【 " & strYYYYMM & " 】シートは存在します。", vbExclamation, "予定表作成"

Exit Sub

End If

ここでは、指定された年月のシートがすでに存在しているかチェックします。

同じ前のシートを作成することができないからです。

「IsExistSheet」関数は、後ほど説明しますが、渡された名称のシートが存在する場合はTRUEを返し、シートが存在しない場合はFALSEを返す関数です。

すでに同じ名前のシートが存在する場合は、メッセージを表示して、予定表作成処理を中止します。

(4)シートを追加する

　　'(4)シートを追加する
    Call AddNewSheet(strYYYYMM)

1 2	'(4)シートを追加する Call AddNewSheet(strYYYYMM)

ここでは、指定された「strYYYYMM」の名称で、新しくシートを追加します。

「AddNewSheet」関数については、後ほど中身を説明します。

例えば、「202007」をこの関数に渡すと、「202007」という名前でシートを追加します。

202007というシートを追加した場合

(5)予定行数を取得する

　　'(5)予定行数を取得する
    iYoteiGyo = toolSht.Range("C4")

1 2	'(5)予定行数を取得する iYoteiGyo = toolSht.Range("C4")

ここでは、「ツール」シートのC4セル（予定行数）の値を取得して、変数「iYoteiGyo」に格納しています。

予定行数を取得する

(6)祝日一覧の最初の行をセットする

    Dim varHoliday As Variant
    Dim iMaxHolidayRow As Integer
    Dim i As Integer
    
    '(6)祝日一覧の最初の行をセットする
    i = 9

Dim varHoliday As Variant

Dim iMaxHolidayRow As Integer

Dim i As Integer

'(6)祝日一覧の最初の行をセットする

i = 9

ここでは、変数「i」に9を格納しています。

なぜなら、祝日一覧の最初の行が9行目だからです。

祝日一覧の最初の行を格納する

変数「varHoliday」は、祝日一覧に入力されている日付すべてを格納するために、ここで宣言しています。

また、変数「iMaxHolidayRow」は、祝日一覧に入力されている最終行番号を格納するために、ここで宣言しています。

(7)祝日一覧の最終行を取得する

    '(7)祝日一覧の最終行を取得する
    Do While True
        If toolSht.Cells(i, 1) <> "" Then
            iMaxHolidayRow = i
            i = i + 1
        Else
            Exit Do
        End If
    Loop

'(7)祝日一覧の最終行を取得する

Do While True

If toolSht.Cells(i, 1) <> "" Then

iMaxHolidayRow = i

i = i + 1

Else

Exit Do

End If

Loop

ここでは、祝日一覧に入力されている最終行を取得しています。

先程、変数「i」には9を格納していますので、「ツール」シートの9行目の1列目の値が空でないかチェックします。

空でない場合、変数「iMaxHoidayRow」に9を格納して、次の行をチェックします。

そして、空が見つかるまで変数「iMaxHolidayRow」をカウントアップして、入力されている最終行を取得します。

例えば、12行目まで祝日が入力されていた場合、変数「iMaxHolidayRow」には12が格納されます。

(8)祝日一覧を配列に取得する

    '(8)祝日一覧を配列に取得する（9行目から入力されている最大行までのA列の値を取得）
    varHoliday = toolSht.Range(toolSht.Cells(9, 1), toolSht.Cells(iMaxHolidayRow, 1))

1 2	'(8)祝日一覧を配列に取得する（9行目から入力されている最大行までのA列の値を取得） varHoliday = toolSht.Range(toolSht.Cells(9, 1), toolSht.Cells(iMaxHolidayRow, 1))

ここでは、入力されている祝日データを最初の行から最終行までを取得して、変数「varHoliday」に格納しています。

例えば、12行目まで祝日が入力されていた場合、9行目から12行目の祝日データを変数「varHoliday」に格納します。

(9)シートを解放する

    '(9)シートを解放する
    Set toolSht = Nothing

1 2	'(9)シートを解放する Set toolSht = Nothing

ここでは、「ツール」シートを使わなくなったので、変数「toolSht」をメモリから解放しています。

もし「シート解放」する処理を書かなくても、いずれ自動的にメモリは解放されますが、明示的にメモリを開放するようにしましょう。

(10)予定表を作成する

    '(10)予定表を作成する
    Call CreateYoteiHyo(strYYYYMM, iYoteiGyo, varHoliday)

1 2	'(10)予定表を作成する Call CreateYoteiHyo(strYYYYMM, iYoteiGyo, varHoliday)

ここでは、のちほど説明する関数「CreateYoteiHyo」に作成する年月、予定行数、祝日一覧を渡しています。

関数「CreateYoteiHyo」は、予定表を作成します。

見出しや指定された年月のカレンダー、罫線を引いたり、背景色をつけたり、セル幅を調整します。

(11)完了メッセージを表示する

    '(11)完了メッセージを表示する
    MsgBox "予定表作成が完了しました。", vbInformation, "予定表作成"

1 2	'(11)完了メッセージを表示する MsgBox "予定表作成が完了しました。", vbInformation, "予定表作成"

ここでは、予定表作成の完了メッセージを表示して、無事に処理が終わったことをツール利用者に知らせます。

完了メッセージ

指定されたシート名のシートが存在するかチェックするVBAプログラム説明

「Sub ボタン1_Click()」から呼び出される「シートが存在するかチェックする」VBAプログラムを説明します。

シートが存在するかチェックするVBAプログラム

'シートが存在するかチェックする
Private Function IsExistSheet(ByVal shtName As String) As Boolean
    IsExistSheet = False
    
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = shtName Then
            IsExistSheet = True
            Exit Function
        End If
    Next
    
End Function

'シートが存在するかチェックする

Private Function IsExistSheet(ByVal shtName As String) As Boolean

IsExistSheet = False

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name = shtName Then

IsExistSheet = True

Exit Function

End If

End Function

ここでは、引数で渡されたシート名（変数「shtName」）が、存在しているか全てのシートの名前を確認します。

同じ名前のシートがすでに存在する場合は、TRUEを返します。

存在しない場合は、FALSEを返します。

指定されたシート名でシートを追加するVBAプログラム説明

「Sub ボタン1_Click()」から呼び出される「指定された名前でシートを追加する」VBAプログラムを説明します。

指定されたシート名でシートを追加するVBAプログラム

(1)存在するシート数を取得する

    '(1)存在するシート数を取得する
    iSheetCnt = ThisWorkbook.Sheets.Count

1 2	'(1)存在するシート数を取得する iSheetCnt = ThisWorkbook.Sheets.Count

ここでは、シート数を取得して、変数「iSheetCnt」に格納しています。

(2)存在するシートの右側に新しいシートを追加する

    '(2)存在するシートの右側に新しいシートを追加する
    Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(iSheetCnt))

1 2	'(2)存在するシートの右側に新しいシートを追加する Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(iSheetCnt))

ここでは、最大のシート（一番右のシート）の右側に新しいシートを追加しています。

追加されたシートは、変数「newSht」に格納します。

なぜ、変数に格納するのかは、あとでこの追加したシートを利用するからです。

(3)新しく追加したシートの名前を変更する

    '(3)新しく追加したシートの名前を変更する
    newSht.Name = shtName

1 2	'(3)新しく追加したシートの名前を変更する newSht.Name = shtName

ここでは、新しく追加したシートの名前を引数「shtName」に格納されている値に変更しています。

(4)シートを解放する

    '(4)シートを解放する
    Set newSht = Nothing

1 2	'(4)シートを解放する Set newSht = Nothing

ここでは、新しく追加したシートを使わなくなったので、変数「newSht」をメモリから解放しています。

予定表を作成するVBAプログラム説明

「Sub ボタン1_Click()」から呼び出される「予定表を作成する」VBAプログラムを説明します。

予定表を作成するVBAプログラムその１

予定表を作成するVBAプログラムその2

予定表を作成するVBAプログラムその3

(1)年と月を取得する

    '(1)年と月を取得する
    iYear = Left(shtName, 4)
    iMonth = Right(shtName, 2)

'(1)年と月を取得する

iYear = Left(shtName, 4)

iMonth = Right(shtName, 2)

ここでは、変数「shtName」に格納されている値（例：202007）の左から4文字を取得し、変数「iYear」に格納しています。

また、右から2文字を取得し、変数「iMonth」に格納しています。

例えば202007の場合、iYearには2020、iMonthには7が格納されます。

iMonthに07を格納しようとすると、前の0がとれて7だけが格納されます。

なぜなら、iMonthは整数型の変数だからです。

ちなみに、iMonthに12を格納しようとすると、そのまま12が格納されます。

(2)指定年月の末日を取得する

    '(2)指定年月の末日を取得する
    datGetumatu = DateAdd("d", -1, DateAdd("m", 1, CDate(iYear & "/" & iMonth & "/1")))
    iMatubi = Day(datGetumatu)

'(2)指定年月の末日を取得する

datGetumatu = DateAdd("d", -1, DateAdd("m", 1, CDate(iYear & "/" & iMonth & "/1")))

iMatubi = Day(datGetumatu)

ここでは、指定された年月の1日の1ヶ月後の日付を取得し、さらに1日前の日付を取得して、変数「datGetumatu」に格納しています。

例えば、指定された年月が2020年7月の場合、2020年7月1日の1ヶ月後（2020年8月1日）を取得し、その1日前（2020年7月31日）を取得します。

すなわち、指定された年月の月末日を取得しようとします。

次に、Day関数を利用して、日にちの値（例：2020年7月31日なら31）を取得し、変数「iMatubi」に格納しています。

‘(3)予定表シートを取得する

    '(3)予定表シートを取得する
    Set yoteiSht = ThisWorkbook.Sheets(shtName)

1 2	'(3)予定表シートを取得する Set yoteiSht = ThisWorkbook.Sheets(shtName)

ここでは、予定表シートを変数「yoteiSht」に格納しています。

なぜなら、このあとのプログラムで、予定表シートをたくさん利用するからです。

(4)値を入力する

    '(4)値を入力する
    With yoteiSht
        '見出しを入力する
        .Range("A1").Value = iYear & "年" & iMonth & "月の予定表"
        .Range("A2").Value = "No."
        .Range("B2").Value = "予定作業"
        .Range("C2").Value = "開始日"
        .Range("D2").Value = "終了日"
        
        '予定表No.を入力する
        For i = 1 To iYoteiGyo
            .Range("A" & 2 + i).Value = i
        Next
        
        'カレンダーの曜日と日付を入力する
        For i = 1 To iMatubi
            strDay = iYear & "/" & iMonth & "/" & i
            .Cells(1, 4 + i).Value = Format(CDate(strDay), "aaa")
            .Cells(2, 4 + i).Value = strDay
            .Cells(2, 4 + i).NumberFormatLocal = "d"
        Next
    End With

'(4)値を入力する

With yoteiSht

'見出しを入力する

.Range("A1").Value = iYear & "年" & iMonth & "月の予定表"

.Range("A2").Value = "No."

.Range("B2").Value = "予定作業"

.Range("C2").Value = "開始日"

.Range("D2").Value = "終了日"

'予定表No.を入力する

For i = 1 To iYoteiGyo

.Range("A" & 2 + i).Value = i

'カレンダーの曜日と日付を入力する

For i = 1 To iMatubi

strDay = iYear & "/" & iMonth & "/" & i

.Cells(1, 4 + i).Value = Format(CDate(strDay), "aaa")

.Cells(2, 4 + i).Value = strDay

.Cells(2, 4 + i).NumberFormatLocal = "d"

End With

ここでは、見出し（予定表のタイトル、No.、予定作業、開始日、終了日）をそれぞれのセルにセットしています。

予定表が2020年7月の場合

作成しようとしている予定表が2020年7月のとき、上記画像の見出しをセットします。

次に、予定表No.を1から指定された予定行数分の番号をそれぞれのセルにセットしています。

予定表No.の例

作成しようとしている予定行数が10のとき、上記画像のように1から10の番号をセットします。

次に、指定された年月の日にちを1日から月末日までをそれぞれのセルにセットします。

また、各日にちの曜日もセルにセットします。

カレンダーの日付と曜日をセット

指定された年月が2020年7月のとき、上記画像のように1から31の日付と曜日をセットします。

最後の「NumberFormatLocal = “d”」は、各日付の日にち部分だけ表示するように書式を設定しています。

例えば、2020年7月1日なら1を表示するようにしています。

‘(5)表示形式を設定する

    '(5)表示形式を設定する
    With yoteiSht
        '開始日、終了日
        .Range(.Cells(3, 3), .Cells(2 + iYoteiGyo, 4)).NumberFormatLocal = "yyyy/m/d"
    End With

'(5)表示形式を設定する

With yoteiSht

'開始日、終了日

.Range(.Cells(3, 3), .Cells(2 + iYoteiGyo, 4)).NumberFormatLocal = "yyyy/m/d"

End With

ここでは、予定表の開始日、終了日を入力セルの表示形式を「yyyy/m/d」で設定しています。

例えば,、2020年7月1日なら2020/7/1と表示されます。

開始日、終了日の表示形式を設定

‘(6)文字配置を設定する

    '(6)文字配置を設定する
    With yoteiSht.Range(yoteiSht.Cells(1, 1), yoteiSht.Cells(2 + iYoteiGyo, 4 + iMatubi))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With yoteiSht.Range(yoteiSht.Cells(3, 2), yoteiSht.Cells(2 + iYoteiGyo, 2))
        .HorizontalAlignment = xlLeft
    End With

'(6)文字配置を設定する

With yoteiSht.Range(yoteiSht.Cells(1, 1), yoteiSht.Cells(2 + iYoteiGyo, 4 + iMatubi))

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

End With

With yoteiSht.Range(yoteiSht.Cells(3, 2), yoteiSht.Cells(2 + iYoteiGyo, 2))

.HorizontalAlignment = xlLeft

End With

ここでは、まず予定表全体の全てのセルの文字配置で、縦位置を真ん中に、横位置を真ん中になるように設定しています。

次に、「予定作業」を入力するセルのみ、横位置を左寄りに設定しています。

予定作業の入力セルを左寄りに設定

予定表が全体的に真ん中配置が多かったため、最初に全体を真ん中配置にし、そのあと個別で左寄り配置を設定することにより、処理回数を減らす工夫をしています。

１つ１つそれぞれの領域の配置設定をすることも可能ですが、できるだけ処理回数を減らすことにより、短いプラグラムで同じことを実現させています。

‘(7)列幅を設定する

    '(7)列幅を設定する
    With yoteiSht
        .Columns(1).ColumnWidth = 3.67  'No.
        .Columns(2).ColumnWidth = 17.22 '予定作業
        .Columns(3).ColumnWidth = 8.33  '開始日
        .Columns(4).ColumnWidth = 8.33  '終了日
        
        'カレンダー幅
        For i = 1 To iMatubi
            .Columns(4 + i).ColumnWidth = 2.78
        Next
    End With

'(7)列幅を設定する

With yoteiSht

.Columns(1).ColumnWidth = 3.67 'No.

.Columns(2).ColumnWidth = 17.22 '予定作業

.Columns(3).ColumnWidth = 8.33 '開始日

.Columns(4).ColumnWidth = 8.33 '終了日

'カレンダー幅

For i = 1 To iMatubi

.Columns(4 + i).ColumnWidth = 2.78

End With

ここでは、各列（No.、予定作業、開始日、終了日、カレンダー）の幅を設定しています。

「予定作業」列は、少し長めの文字を表示可能とするため、他より広めに幅を設定しています。

‘(8)背景色を設定する

    '(8)背景色を設定する
    With yoteiSht
        .Range("A1:D2").Interior.Color = 5296274
        
        '土・日の背景色を設定する
        For i = 1 To iMatubi
            If .Cells(1, 4 + i).Value = "土" Then
                .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 16777164
            ElseIf .Cells(1, 4 + i).Value = "日" Then
                .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459
            Else
                'なにもしない
            End If
            
            '祝日の背景色を設定する
            For j = 1 To UBound(vHoliday)
                If CDate(iYear & "/" & iMonth & "/" & i) = CDate(vHoliday(j, 1)) Then
                    .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459
                    Exit For
                End If
            Next
         Next
    End With

'(8)背景色を設定する

With yoteiSht

.Range("A1:D2").Interior.Color = 5296274

'土・日の背景色を設定する

For i = 1 To iMatubi

If .Cells(1, 4 + i).Value = "土" Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 16777164

ElseIf .Cells(1, 4 + i).Value = "日" Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459

Else

'なにもしない

End If

'祝日の背景色を設定する

For j = 1 To UBound(vHoliday)

If CDate(iYear & "/" & iMonth & "/" & i) = CDate(vHoliday(j, 1)) Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459

Exit For

End If

End With

ここでは、予定表の背景色を設定しています。

見出しの背景色は緑色、カレンダーの土曜日は水色、日曜日と祝日はピンク色で設定しています。

見出しの背景色を設定

カレンダーの土・日・祝の背景色を設定

プログラムの流れとして、先に土曜日と日曜日の背景色を設定し、そのあとで祝日の背景色を設定しています。

もし、土曜日が祝日の場合、先に土曜日の背景色を設定したあとに、祝日の背景色で上書きされます。

祝日の判定は、祝日一覧に入力されている日付とそれぞれの日付が同じかどうかで判定させています。

‘(9)セル結合する

    '(9)セル結合する
    yoteiSht.Range("A1:D1").Merge

1 2	'(9)セル結合する yoteiSht.Range("A1:D1").Merge

ここでは、予定表のタイトル（○○○○年○月の予定表）が表示されるA1セル～D1セルを結合しています。

予定表タイトルセルの結合

‘(10)文字サイズを設定する

    '(10)文字サイズを設定する
    yoteiSht.Range("A1:D1").Font.Size = 18

1 2	'(10)文字サイズを設定する yoteiSht.Range("A1:D1").Font.Size = 18

ここでは、予定表のタイトル部分のみ文字サイズを大きく設定しています。

‘(11)罫線を引く

    '(11)罫線を引く
    With yoteiSht
        .Range(.Cells(1, 1), .Cells(2 + iYoteiGyo, 4 + iMatubi)).Borders.LineStyle = True
    End With

'(11)罫線を引く

With yoteiSht

.Range(.Cells(1, 1), .Cells(2 + iYoteiGyo, 4 + iMatubi)).Borders.LineStyle = True

End With

ここでは、予定表全体に対して、罫線を引いています。

具体的には、左上（A1セル）～カレンダーの右下セルまでを対象としています。

カレンダーの右下セルは、予定行数によって変化します。

‘(12)シートを解放する

    '(12)シートを解放する
    Set yoteiSht = Nothing

1 2	'(12)シートを解放する Set yoteiSht = Nothing

ここでは、予定表シートを使わなくなったので、変数「yoteiSht」をメモリから解放しています。

今回の予定表作成ツールすべてのVBAプログラム

それでは、最後にすべてのVBAプログラムを以下に掲載しておきます。

Option Explicit

'「予定表作成ボタン」クリック処理
Sub ボタン1_Click()
    Dim toolSht As Worksheet
    Dim strYYYYMM As String
    Dim iYoteiGyo As Integer
    
    '(1)ツールシートを取得する
    Set toolSht = ThisWorkbook.Sheets("ツール")
    
    '(2)対象年月を取得する
    strYYYYMM = toolSht.Range("A4") & Format(toolSht.Range("B4"), "00")
    
    '(3)シートが存在するかチェックする
    If IsExistSheet(strYYYYMM) Then
        MsgBox "すでに【 " & strYYYYMM & " 】シートは存在します。", vbExclamation, "予定表作成"
        Exit Sub
    End If
    
    '(4)シートを追加する
    Call AddNewSheet(strYYYYMM)
    
    '(5)予定行数を取得する
    iYoteiGyo = toolSht.Range("C4")
    
    Dim varHoliday As Variant
    Dim iMaxHolidayRow As Integer
    Dim i As Integer
    
    '(6)祝日一覧の最初の行をセットする
    i = 9
    
    '(7)祝日一覧の最終行を取得する
    Do While True
        If toolSht.Cells(i, 1) <> "" Then
            iMaxHolidayRow = i
            i = i + 1
        Else
            Exit Do
        End If
    Loop
    
    '(8)祝日一覧を配列に取得する（9行目から入力されている最大行までのA列の値を取得）
    varHoliday = toolSht.Range(toolSht.Cells(9, 1), toolSht.Cells(iMaxHolidayRow, 1))
    
    '(9)シートを解放する
    Set toolSht = Nothing
    
    '(10)予定表を作成する
    Call CreateYoteiHyo(strYYYYMM, iYoteiGyo, varHoliday)
    
    '(11)完了メッセージを表示する
    MsgBox "予定表作成が完了しました。", vbInformation, "予定表作成"
    
End Sub

'シートが存在するかチェックする
Private Function IsExistSheet(ByVal shtName As String) As Boolean
    IsExistSheet = False
    
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = shtName Then
            IsExistSheet = True
            Exit Function
        End If
    Next
    
End Function

'指定された名前でシートを追加する
Private Sub AddNewSheet(ByVal shtName As String)
    Dim newSht As Worksheet
    Dim iSheetCnt As Integer
    
    '(1)存在するシート数を取得する
    iSheetCnt = ThisWorkbook.Sheets.Count
    
    '(2)存在するシートの右側に新しいシートを追加する
    Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(iSheetCnt))
    
    '(3)新しく追加したシートの名前を変更する
    newSht.Name = shtName
    
    '(4)シートを解放する
    Set newSht = Nothing
    
End Sub

'予定表を作成する
Private Sub CreateYoteiHyo(ByVal shtName As String, ByVal iYoteiGyo As Integer, ByRef vHoliday As Variant)
    Dim yoteiSht As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim datGetumatu As Date
    Dim iMatubi As Integer
    Dim strDay As String
    
    '(1)年と月を取得する
    iYear = Left(shtName, 4)
    iMonth = Right(shtName, 2)
    
    '(2)指定年月の末日を取得する
    datGetumatu = DateAdd("d", -1, DateAdd("m", 1, CDate(iYear & "/" & iMonth & "/1")))
    iMatubi = Day(datGetumatu)
    
    '(3)予定表シートを取得する
    Set yoteiSht = ThisWorkbook.Sheets(shtName)

    '(4)値を入力する
    With yoteiSht
        '見出しを入力する
        .Range("A1").Value = iYear & "年" & iMonth & "月の予定表"
        .Range("A2").Value = "No."
        .Range("B2").Value = "予定作業"
        .Range("C2").Value = "開始日"
        .Range("D2").Value = "終了日"
        
        '予定表No.を入力する
        For i = 1 To iYoteiGyo
            .Range("A" & 2 + i).Value = i
        Next
        
        'カレンダーの曜日と日付を入力する
        For i = 1 To iMatubi
            strDay = iYear & "/" & iMonth & "/" & i
            .Cells(1, 4 + i).Value = Format(CDate(strDay), "aaa")
            .Cells(2, 4 + i).Value = strDay
            .Cells(2, 4 + i).NumberFormatLocal = "d"
        Next
    End With
    
    '(5)表示形式を設定する
    With yoteiSht
        '開始日、終了日
        .Range(.Cells(3, 3), .Cells(2 + iYoteiGyo, 4)).NumberFormatLocal = "yyyy/m/d"
    End With
    
    '(6)文字配置を設定する
    With yoteiSht.Range(yoteiSht.Cells(1, 1), yoteiSht.Cells(2 + iYoteiGyo, 4 + iMatubi))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With yoteiSht.Range(yoteiSht.Cells(3, 2), yoteiSht.Cells(2 + iYoteiGyo, 2))
        .HorizontalAlignment = xlLeft
    End With
            
    '(7)列幅を設定する
    With yoteiSht
        .Columns(1).ColumnWidth = 3.67  'No.
        .Columns(2).ColumnWidth = 17.22 '予定作業
        .Columns(3).ColumnWidth = 8.33  '開始日
        .Columns(4).ColumnWidth = 8.33  '終了日
        
        'カレンダー幅
        For i = 1 To iMatubi
            .Columns(4 + i).ColumnWidth = 2.78
        Next
    End With

            
    '(8)背景色を設定する
    With yoteiSht
        .Range("A1:D2").Interior.Color = 5296274
        
        '土・日の背景色を設定する
        For i = 1 To iMatubi
            If .Cells(1, 4 + i).Value = "土" Then
                .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 16777164
            ElseIf .Cells(1, 4 + i).Value = "日" Then
                .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459
            Else
                'なにもしない
            End If
            
            '祝日の背景色を設定する
            For j = 1 To UBound(vHoliday)
                If CDate(iYear & "/" & iMonth & "/" & i) = CDate(vHoliday(j, 1)) Then
                    .Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459
                    Exit For
                End If
            Next
         Next
    End With

    '(9)セル結合する
    yoteiSht.Range("A1:D1").Merge
    
    '(10)文字サイズを設定する
    yoteiSht.Range("A1:D1").Font.Size = 18
    
    '(11)罫線を引く
    With yoteiSht
        .Range(.Cells(1, 1), .Cells(2 + iYoteiGyo, 4 + iMatubi)).Borders.LineStyle = True
    End With

    '(12)シートを解放する
    Set yoteiSht = Nothing
    
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

Option Explicit

'「予定表作成ボタン」クリック処理

Sub ボタン1_Click()

Dim toolSht As Worksheet

Dim strYYYYMM As String

Dim iYoteiGyo As Integer

'(1)ツールシートを取得する

Set toolSht = ThisWorkbook.Sheets("ツール")

'(2)対象年月を取得する

strYYYYMM = toolSht.Range("A4") & Format(toolSht.Range("B4"), "00")

'(3)シートが存在するかチェックする

If IsExistSheet(strYYYYMM) Then

MsgBox "すでに【 " & strYYYYMM & " 】シートは存在します。", vbExclamation, "予定表作成"

Exit Sub

End If

'(4)シートを追加する

Call AddNewSheet(strYYYYMM)

'(5)予定行数を取得する

iYoteiGyo = toolSht.Range("C4")

Dim varHoliday As Variant

Dim iMaxHolidayRow As Integer

Dim i As Integer

'(6)祝日一覧の最初の行をセットする

i = 9

'(7)祝日一覧の最終行を取得する

Do While True

If toolSht.Cells(i, 1) <> "" Then

iMaxHolidayRow = i

i = i + 1

Else

Exit Do

End If

Loop

'(8)祝日一覧を配列に取得する（9行目から入力されている最大行までのA列の値を取得）

varHoliday = toolSht.Range(toolSht.Cells(9, 1), toolSht.Cells(iMaxHolidayRow, 1))

'(9)シートを解放する

Set toolSht = Nothing

'(10)予定表を作成する

Call CreateYoteiHyo(strYYYYMM, iYoteiGyo, varHoliday)

'(11)完了メッセージを表示する

MsgBox "予定表作成が完了しました。", vbInformation, "予定表作成"

End Sub

'シートが存在するかチェックする

Private Function IsExistSheet(ByVal shtName As String) As Boolean

IsExistSheet = False

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name = shtName Then

IsExistSheet = True

Exit Function

End If

End Function

'指定された名前でシートを追加する

Private Sub AddNewSheet(ByVal shtName As String)

Dim newSht As Worksheet

Dim iSheetCnt As Integer

'(1)存在するシート数を取得する

iSheetCnt = ThisWorkbook.Sheets.Count

'(2)存在するシートの右側に新しいシートを追加する

Set newSht = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(iSheetCnt))

'(3)新しく追加したシートの名前を変更する

newSht.Name = shtName

'(4)シートを解放する

Set newSht = Nothing

End Sub

'予定表を作成する

Private Sub CreateYoteiHyo(ByVal shtName As String, ByVal iYoteiGyo As Integer, ByRef vHoliday As Variant)

Dim yoteiSht As Worksheet

Dim i As Integer

Dim j As Integer

Dim iYear As Integer

Dim iMonth As Integer

Dim datGetumatu As Date

Dim iMatubi As Integer

Dim strDay As String

'(1)年と月を取得する

iYear = Left(shtName, 4)

iMonth = Right(shtName, 2)

'(2)指定年月の末日を取得する

datGetumatu = DateAdd("d", -1, DateAdd("m", 1, CDate(iYear & "/" & iMonth & "/1")))

iMatubi = Day(datGetumatu)

'(3)予定表シートを取得する

Set yoteiSht = ThisWorkbook.Sheets(shtName)

'(4)値を入力する

With yoteiSht

'見出しを入力する

.Range("A1").Value = iYear & "年" & iMonth & "月の予定表"

.Range("A2").Value = "No."

.Range("B2").Value = "予定作業"

.Range("C2").Value = "開始日"

.Range("D2").Value = "終了日"

'予定表No.を入力する

For i = 1 To iYoteiGyo

.Range("A" & 2 + i).Value = i

'カレンダーの曜日と日付を入力する

For i = 1 To iMatubi

strDay = iYear & "/" & iMonth & "/" & i

.Cells(1, 4 + i).Value = Format(CDate(strDay), "aaa")

.Cells(2, 4 + i).Value = strDay

.Cells(2, 4 + i).NumberFormatLocal = "d"

End With

'(5)表示形式を設定する

With yoteiSht

'開始日、終了日

.Range(.Cells(3, 3), .Cells(2 + iYoteiGyo, 4)).NumberFormatLocal = "yyyy/m/d"

End With

'(6)文字配置を設定する

With yoteiSht.Range(yoteiSht.Cells(1, 1), yoteiSht.Cells(2 + iYoteiGyo, 4 + iMatubi))

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

End With

With yoteiSht.Range(yoteiSht.Cells(3, 2), yoteiSht.Cells(2 + iYoteiGyo, 2))

.HorizontalAlignment = xlLeft

End With

'(7)列幅を設定する

With yoteiSht

.Columns(1).ColumnWidth = 3.67 'No.

.Columns(2).ColumnWidth = 17.22 '予定作業

.Columns(3).ColumnWidth = 8.33 '開始日

.Columns(4).ColumnWidth = 8.33 '終了日

'カレンダー幅

For i = 1 To iMatubi

.Columns(4 + i).ColumnWidth = 2.78

End With

'(8)背景色を設定する

With yoteiSht

.Range("A1:D2").Interior.Color = 5296274

'土・日の背景色を設定する

For i = 1 To iMatubi

If .Cells(1, 4 + i).Value = "土" Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 16777164

ElseIf .Cells(1, 4 + i).Value = "日" Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459

Else

'なにもしない

End If

'祝日の背景色を設定する

For j = 1 To UBound(vHoliday)

If CDate(iYear & "/" & iMonth & "/" & i) = CDate(vHoliday(j, 1)) Then

.Range(.Cells(1, 4 + i), .Cells(2 + iYoteiGyo, 4 + i)).Interior.Color = 14526459

Exit For

End If

End With

'(9)セル結合する

yoteiSht.Range("A1:D1").Merge

'(10)文字サイズを設定する

yoteiSht.Range("A1:D1").Font.Size = 18

'(11)罫線を引く

With yoteiSht

.Range(.Cells(1, 1), .Cells(2 + iYoteiGyo, 4 + iMatubi)).Borders.LineStyle = True

End With

'(12)シートを解放する

Set yoteiSht = Nothing

End Sub

４．最後に

今回ご説明しました「予定表作成ツール」のVBAプログラムは、プログラムを短くするために本当は必要なチェック機能を省いています。

例えば、以下のチェック機能を省いています。

入力された年が数字で入力されているか
年が４桁で入力されているか
入力された月が数字で入力されているか
月が1～12の数字で入力されているか
祝日一覧に入力されている日付が正しい日付か

正しく入力すれば正常に動作しますが、間違った入力をされるとエラーが発生します。

その点はご注意ください。

また、作成される予定表に必要な項目を追加したり、カレンダーの祝日の背景色を変えたり、いろいろアレンジしてみてください。

そうすることにより、VBAプログラムの理解がさらに深まります。

ぜひ、チャレンジしてみてください。

最後に、お役に立てれれば、幸いです。

以上です。

１．今回作成する予定表作成ツールの説明

予定表作成ツールの実行画面

指定された年月（2020年7月）の予定表シート

２．予定表作成実行画面（ツールシート）の作成方法

年・月・予定行数を入力するセルを準備する

予定表作成ボタンを配置する

祝日一覧を入力するセルを準備する

３．予定表を作成するVBAプログラムを入力する

「予定表作成ボタン」クリック処理のVBAプログラム説明

(1)ツールシートを取得する

(2)対象年月を取得する

(3)シートが存在するかチェックする

(4)シートを追加する

(5)予定行数を取得する

(6)祝日一覧の最初の行をセットする

(7)祝日一覧の最終行を取得する

(8)祝日一覧を配列に取得する

(9)シートを解放する

(10)予定表を作成する

(11)完了メッセージを表示する

指定されたシート名のシートが存在するかチェックするVBAプログラム説明

指定されたシート名でシートを追加するVBAプログラム説明

(1)存在するシート数を取得する

(2)存在するシートの右側に新しいシートを追加する

(3)新しく追加したシートの名前を変更する

(4)シートを解放する

予定表を作成するVBAプログラム説明

(1)年と月を取得する

(2)指定年月の末日を取得する

‘(3)予定表シートを取得する

(4)値を入力する

‘(5)表示形式を設定する

‘(6)文字配置を設定する

‘(7)列幅を設定する

‘(8)背景色を設定する

‘(9)セル結合する

‘(10)文字サイズを設定する

‘(11)罫線を引く

‘(12)シートを解放する

今回の予定表作成ツールすべてのVBAプログラム

４．最後に

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル