エクセル小僧：カレンダを作る（３）

エクセル小僧：カレンダを作る(2)
http://cheese999.blog.so-net.ne.jp/2018-04-17

で、７列　X　６段の枠を作って、日付を埋めていく説明をしました。

（リネン交換の当番表を作って説明しているため、日付：１行、当番表の内部処理用の行：４行、当日の作業対象のベッドA - ベッドDを表示する行：４行の９行の、ひとまとまりを１段と表現します。）

エクセル小僧：カレンダを作る
http://cheese999.blog.so-net.ne.jp/2018-04-05

で説明したように、カレンダは、月によっては４段や５段しか必要としない月もあるため、５段目と６段目に今月の日付が無い時は、非表示にするマクロを作ってみました。

Sub mySHideNoUseLine1(myWkSht1 As Worksheet, myDate1 As Date, myDate2 As Date, _
myRows1 As Variant, myRows2 As Variant, myRange1 As Variant, myRange2 As Variant)
  '【機能】今月の日付のない行を非表示
  '【引数】
  ' myWkSht1 : 対象ワークシート
  ' myDate1 : 対象段の先頭セルの日付
  ' myDate2 : 対象月の先頭日の日付
  ' myRows1 : 日付の行番号
  ' myRows2 : ベッドA - Dの行番号
  ' myRange1 : 日付の1行上のセル範囲
  ' myRange2 : 日付のセル範囲
  '【変数】
  '【実行コード】
  If Month(myDate1) <> Month(myDate2) Then
    myWkSht1.Rows(myRows1).Select
    Selection.EntireRow.Hidden = True
    myWkSht1.Rows(myRows2).Select
    Selection.EntireRow.Hidden = True
    ' 日付の上の線を細い一重線に
    myWkSht1.Range(myRange2).Select
    With Selection.Borders(xlEdgeTop)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
    End With
    myWkSht1.Range(myRange1).Select
    With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThin
    End With
  Else
    myWkSht1.Rows(myRows1).Select
    Selection.EntireRow.Hidden = False
    myWkSht1.Rows(myRows2).Select
    Selection.EntireRow.Hidden = False
    ' 日付の上の線を二重線に
    myWkSht1.Range(myRange2).Select
    With Selection.Borders(xlEdgeTop)
      .LineStyle = xlDouble
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThick
    End With
    myWkSht1.Range(myRange1).Select
    With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlDouble
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .Weight = xlThick
    End With
  End If
End Sub

５段目と６段目の先頭日の日付（月曜始まりなら、月曜）と、その月の先頭日（１日）の月を比較して、異なっているなら、その段を非表示、そうでないなら、表示するマクロです。

最下段の下の罫線を一重線に、段と段の間の罫線を二重線にする処理も入っています。

上記のmySHideNoUseLine1マクロを呼ぶ方のマクロは、カレンダの月日が変更されたときに呼ばれるWorksheet_Changeマクロとします。

Private Sub Worksheet_Change(ByVal Target As Range)
  '【イベント】セルの値が変更された時
  '【変数】

（中略）

  Dim WkSht1 As Worksheet ' ワークシート
  Dim Arr_Rows1() As Variant ' 行番号の配列
  Dim Arr_Range1() As Variant ' セル範囲の配列

（中略）

  '【実行コード】

（中略）

  ' 今月の日付が無い段を非表示
  Arr_Rows1 = Array("40:40", "45:48", "49:49", "54:57", "97:97", "102:105", "106:106", "111:114")
  Arr_Range1 = Array("B39:H39", "B40:H40", "B48:H48", "B49:H49", "B96:H96", "B97:H97", "B105:H105", "B106:H106")
  Set WkSht1 = ActiveSheet
  If WkSht1.ProtectContents = True Then
    WkSht1.Unprotect ' シート保護を解除
  End If
  ' 1か月目の5段目の非表示処理。"日付1_29"は、その段の先頭セルの日付。"初日date2"は、1か月目の先頭日。
  Call mySHideNoUseLine1(WkSht1, Range("日付1_29").Value, Range("初日date2").Value, _
  Arr_Rows1(0), Arr_Rows1(1), Arr_Range1(0), Arr_Range1(1))
  ' 1か月目の6段目の非表示処理。"日付1_36"は、その段の先頭セルの日付。
  Call mySHideNoUseLine1(WkSht1, Range("日付1_36").Value, Range("初日date2").Value, _
  Arr_Rows1(2), Arr_Rows1(3), Arr_Range1(2), Arr_Range1(3))
  ' 2か月目の5段目の非表示処理。"日付2_29"は、その段の先頭セルの日付。
  Call mySHideNoUseLine1(WkSht1, Range("日付2_29").Value, WorksheetFunction.EDate(Range("初日date2").Value, 1), _
  Arr_Rows1(4), Arr_Rows1(5), Arr_Range1(4), Arr_Range1(5))
  ' 2か月目の6段目の非表示処理。"日付2_36"は、その段の先頭セルの日付。
  Call mySHideNoUseLine1(WkSht1, Range("日付2_36").Value, WorksheetFunction.EDate(Range("初日date2").Value, 1), _
  Arr_Rows1(6), Arr_Rows1(7), Arr_Range1(6), Arr_Range1(7))

（中略）

End Sub

タグ：カレンダ VBA Worksheet_Change エクセル

コメント 2

ヤバイぜ!　ありがとうございます[__猫]
by cheese999 (2018-05-09 07:20) 

説明を追記しました。
by cheese999 (2018-05-09 08:08)