'日付をセットし罫線を引く
Private Sub DaySet(mkbook As String)
Dim i As Integer
Dim s As String
Dim saijitu As String
Dim lastday As Integer
Dim tdate As Date
Dim ncol As Integer
Dim nrow As Integer
tdate = Format(Range("C10") & "/" & Range("C11") & "/1", "yyyy/mm/dd")
Workbooks(mkbook).ActiveSheet.Range(Range("C2")).Select
lastday = MonthLastDay(Range("C10"), Range("C11"))
For i = 1 To lastday
'国民の祝日か判定
saijitu = GetSaijituName(tdate)
If saijitu <> "" Then
'フォント色をセット
ActiveCell.Font.Color = Range("C8").Interior.Color
'祭日名のコメントを追加
ActiveCell.AddComment saijitu
'追加したコメントを選択
Selection.Comment.Shape.Select True
'自動サイズにする
Selection.AutoSize = True
' コメントを非表示する
ActiveCell.Comment.Visible = False
Else
'曜日の取得
s = GetWeekDay(tdate)
'文字のフォント色をセット
If s = "日" Then
ActiveCell.Font.Color = Range("C7").Interior.Color
ElseIf s = "土" Then
ActiveCell.Font.Color = Range("C6").Interior.Color
Else
ActiveCell.Font.Color = Range("C5").Interior.Color
End If
End If
'中央配置
ActiveCell.HorizontalAlignment = xlHAlignCenter
ActiveCell = i & "(" & s & ")"
tdate = tdate + 1
If Range("C3") = 1 Then
'横方向
ActiveCell.Offset(columnOffset:=1).Activate
Else
ActiveCell.Offset(rowOffset:=1).Activate
End If
Next
'罫線を引く
ncol = Workbooks(mkbook).ActiveSheet.Range(Range("C2")).Column
nrow = Workbooks(mkbook).ActiveSheet.Range(Range("C2")).Row
With Workbooks(mkbook).ActiveSheet
ncol = .Range(Range("C2")).Column
nrow = .Range(Range("C2")).Row
.Cells(nrow, ncol).Select
'全体の格子罫線
If Range("C3") = 1 Then
.Range(.Cells(nrow, ncol), .Cells(nrow + Range("C4"), ncol + lastday - 1)).Select
Else
.Range(.Cells(nrow, ncol), .Cells(nrow + lastday - 1, ncol + Range("C4"))).Select
End If
Selection.Borders.Weight = xlThin
Selection.Borders.LineStyle = xlContinuous
'日付範囲の外枠
If Range("C3") = 1 Then
.Range(.Cells(nrow, ncol), .Cells(nrow, ncol + lastday - 1)).Select
Else
.Range(.Cells(nrow, ncol), .Cells(nrow + lastday - 1, ncol)).Select
End If
DoWakuKeisen
'全体の外枠
If Range("C3") = 1 Then
.Range(.Cells(nrow, ncol), .Cells(nrow + Range("C4"), ncol + lastday - 1)).Select
Else
.Range(.Cells(nrow, ncol), .Cells(nrow + lastday - 1, ncol + Range("C4"))).Select
End If
DoWakuKeisen
.Range("A1").Select
End With
End Sub
標準モジュールコードに入力したVBA
下のプロシージャを追加してください。
'外枠 太線
Public Sub DoWakuKeisen()
' Range(srange).Select
'左罫線
With Selection.Borders(xlEdgeLeft)
.Weight = xlThick
.LineStyle = xlContinuous
End With
'上罫線
With Selection.Borders(xlEdgeTop)
.Weight = xlThick
.LineStyle = xlContinuous
End With
'右罫線
With Selection.Borders(xlEdgeRight)
.Weight = xlThick
.LineStyle = xlContinuous
End With
'下罫線
With Selection.Borders(xlEdgeBottom)
.Weight = xlThick
.LineStyle = xlContinuous
End With
End Sub