Excel VBA 35　

入力の簡単なシフト表

プロシジャー

• Call CellSheetON  出勤日を入力する
• Call CellSheetOFF  休暇日を入力する
• Call ShiftLidt001  その月の日付を作る
• Call addBoarders  罫線を作成する
• Call AddCustomContextMenu  コンテキストメニューを追加する

出勤日を入力する

Sub CellSheetON()
    Dim selectedRange As Range
    Dim cell As Range
    
    ' 選択範囲を取得
    Set selectedRange = Selection
    
    ' 選択された各セルに"＊"を追加
    For Each cell In selectedRange
        cell.Value = "出"
        cell.HorizontalAlignment = xlCenter
        cell.Interior.Color = RGB(0, 0, 255)
        cell.Font.Color = RGB(255, 255, 255)
    Next cell
    
    Set selectedRange = Nothing
End Sub

休暇日を入力する

Sub CellSheetOFF()
    Dim selectedRange As Range
    Dim cell As Range
    
    ' 選択範囲を取得
    Set selectedRange = Selection
    
    ' 選択された各セルに"＊"を追加
    For Each cell In selectedRange
        cell.Value = "休"
        cell.HorizontalAlignment = xlCenter
        cell.Interior.Color = RGB(255, 0, 0)
        cell.Font.Color = RGB(255, 255, 255)
    Next cell
    
    Set selectedRange = Nothing
End Sub

その月の日付を作る

Sub ShiftLidt001()
  Dim cdy As Date
  Dim lastDayOfMonth As Integer
  Dim i As Integer
  Dim ws As Worksheet
    
  ' 今日の日付を取得
  cdy = #5/1/2024#
  Set ws = Worksheets("Sheet3")
    
  ' 今月の最後の日を取得
  lastDayOfMonth = Day(DateSerial(Year(cdy), Month(cdy) + 1, 0))
  
  ws.Cells(3, 2) = cdy
  ws.Cells(3, 2).NumberFormat = "yyyy/mm"
  
  ws.Cells(6, 1) = "No"
  ws.Cells(6, 2) = "名前"
  
  Columns("A:B").ColumnWidth = 15
  Columns("C:AC").ColumnWidth = 3
  
  For i = 1 To lastDayOfMonth
    curDate = DateSerial(Year(cdy), Month(cdy), i)
    With ws.Cells(5, 2 + i) '日付
       .NumberFormat = "dd"
       .HorizontalAlignment = xlCenter
       .Value = curDate
    End With
    
    With ws.Cells(6, 2 + i) '曜日
       wd = weekdayName(Weekday(curDate, vbSunday), True, vbUseSystemDayOfWeek)
       .Value = wd
       .HorizontalAlignment = xlCenter
    End With
  Next i

End Sub

罫線を作成する

Sub addBoarders()
  Dim ws As Worksheet
  Set ws = Worksheets("sheet3")
  
  With ws.Range("A5:AG15").Borders
         .LineStyle = xlContinuous   ' 罫線のスタイルを設定
         .Weight = xlThin            ' 罫線の太さを設定
         .ColorIndex = xlAutomatic   ' 罫線の色を自動で設定
  End With

End Sub

コンテキストメニューを追加する

' コンテキストメニューにカスタムコマンドを追加
Sub AddCustomContextMenu()
    Dim cbar As CommandBar
    Dim cbarBtn As CommandBarButton
    Dim cbarCtrl As CommandBarControl
    
    ' コンテキストメニューを取得
    Set cbar = Application.CommandBars("Cell")
    
    ' 既存のコマンドを削除
    On Error Resume Next
    cbar.Controls("CellSheetOFF").Delete
    cbar.Controls("CellSheetON").Delete
    On Error GoTo 0
    
    ' コマンドを追加
    Set cbarBtn = cbar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With cbarBtn
        .Caption = "休"
        .OnAction = "CellSheetOFF"
    End With
     ' コマンドを追加
    Set cbarBtn = cbar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With cbarBtn
        .Caption = "出"
        .OnAction = "CellSheetON"
    End With
End Sub