エクセルVBAでカレンダー作成したいのですが(罫線)

質問

エクセルVBAでカレンダーを作りたいのですが、次の点が分かりません。

1.　月末日が４週目にくる場合と５週目にくる場合があり、罫線を引く範囲が変わってしまいます。usedrange等で範囲指定後罫線を引きたいのですが、各セルは数式により日にちを表示させているので、月末日以降の空白セルまで範囲指定指定しまい４週で終わる月であっても５週目まで罫線を引くことになります。セル内の数式を無視し、月末日までの週を範囲指定する方法をご教授ください。

回答No.4

zap35

どのようなカレンダを作成されているのか質問からだけでは分かりませんが、週初めの曜日がA列、週終わりの曜日がG列なら、(A列に日付が入っている) Or (G列に日付が入っている) 条件に合致する行のA列：G列のみ１行単位に枠線を指定したらどうでしょうか

お礼

ありがとうございます。一度試してみます・

回答No.3

Wendy02

こんばんは。

最初に、どこかに（シリアル値の）日付はありませんか？

UsedRange は、あまりうまくありません。とんでもない場所に飛んでしまうことがあります。CurrentRegion なら分かりますが。しかし、やはり、それは、明示的に範囲を決めたほうがよいと思います。

なお、通常は、マクロではなくて、すべて計算で行います。私の作ったカレンダーで、六曜カレンダだけが、VBAを使っています。罫線をつけたり抜いたりするのは、条件付書式で行います。

このマクロは、週の曜日などが考慮されていませんから、週の数そのままでしか出ません。

lDate は、晦日（みそか）の日付データです。こうすると、晦日が何週目か出てきます。

　cnt = Int((Day(lDate) - 1 + Weekday(lDate - Day(lDate))) / 7) + 1

この「+1」のところをひとつ増やせば、出ます。

　晦日(lDate)の出し方　mDate は、その月の任意の日付です。
lDate = DateSerial(Year(mDate), Month(mDate) + 1, 1) - 1

これは、あくまでもサンプルで、マクロを読んで、場所の特定化などさせるようにしてください。最初に、何も書かれていないシートで試してみて、実際に当てはまるようにさせてください。

'標準モジュール
'-----------------------------------------------

Sub WeeksInMonthCount()
　Dim mDate As Date
　Dim lDate As Date
　Dim cnt As Integer '週の数
　'日付のあるセルにおきます。
　'本来は、ActiveCell ではなく、特定のセルに決めておきます。
　If IsDate(ActiveCell.Text) = False Then
　　MsgBox "日付のあるセルを置いてください。", vbInformation
　　Exit Sub
　Else
　　mDate = CDate(ActiveCell.Text)
　　lDate = DateSerial(Year(mDate), Month(mDate) + 1, 1) - 1
　End If
　'週の数
　cnt = Int((Day(lDate) - 1 + Weekday(lDate - Day(lDate))) / 7) + 1
　Range("A1").CurrentRegion.Borders.LineStyle = xlNone
　With Range("A1").Resize(cnt, 7)
　　With .Borders
　　　.LineStyle = xlContinuous
　　　.Weight = xlThin
　　　.ColorIndex = 1 '黒
　　End With
　End With
　''Call PutInDate(mDate)
End Sub

Sub PutInDate(mDate As Date)
'日付を入れるマクロです。
Dim n As Integer
Dim m As Integer
n = 1
Range("A1").ClearContents
For i = DateSerial(Year(mDate), Month(mDate), 1) To DateSerial(Year(mDate), Month(mDate) + 1, 1) - 1
　　If Day(i) = 1 And Weekday(i) = 1 Then
　　　 m = Weekday(i)
　　ElseIf Weekday(i) = 1 Then
　　　 n = n + 1
　　　 m = Weekday(i)
　　Else
　　　 m = Weekday(i)
　　End If
　　　 Cells(n, m).Value = i
Next i
End Sub

お礼

ありがとうございます。一度試してみます・

回答No.2

imogasi

色んなやり方がありえる。一例
Sub test01()
nen = 2007
tuki = 2
df = DateSerial(nen, tuki, 1) '月初日
wf = Weekday(df) + 1 '開始行がＢ列で＋１
dl = DateSerial(nen, tuki + 1, 1) - 1 '月末日
nissu = Day(dl) '月日数
'--初期化
j = 4 '開始行は第４行
k = wf '開始列Ｂ列
Range("B4:H10").Clear '日付範囲クリア
'--
For i = 1 To nissu '月の末日までの日数字について
If Weekday(DateSerial(nen, tuki, i)) = 1 Then
j = j + 1 '次行へ
k = 2 'Ｂ列に位置づけ
End If
Cells(j, k) = i '日数字をセット
k = k + 1
Next i
'--罫線
Dim cl As Range
Range(Cells(4, "B"), Cells(j, 8)).Select
For Each cl In Selection
cl.Borders(xlEdgeLeft).LineStyle = xlContinuous
cl.Borders(xlEdgeTop).LineStyle = xlContinuous
cl.Borders(xlEdgeBottom).LineStyle = xlContinuous
cl.Borders(xlEdgeRight).LineStyle = xlContinuous
cl.Borders(xlEdgeLeft).LineStyle = xlContinuous

Next
End Sub
Ｂ４：Ｈ４に日ー土を入れる。
年、月はＡ１：Ｂ１などに入れる（上記では略）
Ｂ４：Ｈ１０の書式は、数に設定

回答No.1

ham_kamo

こんな感じでしょうか。UsedRangeの最終行の１列目が空文字列の場合、それより上の範囲をRにセットします。

Sub test()
　　Dim R As Range
　　Set R = UsedRange
　　If R.Cells(R.Rows.Count, 1).Text = "" Then
　　　　Set R = R.Resize(R.Rows.Count - 1)
　　End If
　　R.Select
End Sub

お礼

ありがとうございます。一度試してみます・・・