ここから本文です

VBAで縦型カレンダーを教えて頂きました。 今はテンプレートシートがあり、新しく...

bqq********さん

2020/4/501:00:03

VBAで縦型カレンダーを教えて頂きました。
今はテンプレートシートがあり、新しくシートが出来る仕組みになっています。
これを下記のように変更したいのですが、どうしたらいいでしょうか?

①テンプレートシートの日付、曜日が変わるようにしたい
②テンプレートシート1、2、3と3つあり3つのシートすべて変更したい

今のコードは下記の通りです。
アドバイスお願い致します。

Private Sub 日付更新_Click()

Dim xInp As Variant, xHol As Range
Dim xDate As Date, xDateS As Date, xDateE As Date
Dim xDay As Long, xWek As Long
xInp = Application.InputBox(Prompt:="年月?", Type:=2)
If TypeName(xInp) = "Boolean" Then Exit Sub
Set xHol = Worksheets("祝日").Range("A:A")
xDateS = CDate(xInp & "/1")
xDateE = WorksheetFunction.EoMonth(xDateS, 0)

xName = Format(xDateS, "yyyy年mm月予定表")
On Error Resume Next
Set sh = Worksheets(xName)
If Err.Number = 0 Then
MsgBox xName & "のシートは作成済です"
Exit Sub
End If
On Error GoTo 0

Worksheets("テンプレート").Copy before:=Worksheets(1)
With ActiveSheet
.Range("B2").Value = xName
.Name = xName
.Range("B5").Value = Format(xDateS, "m月")
For xDate = xDateS To xDateE
xDay = Day(xDate)
xWek = Weekday(xDate, vbSunday)
With .Cells(xDay * 3 + 5, 2)
.Value = xDay
.Offset(, 1).Value = WeekdayName(xWek, True)
With .Resize(, 2)
If xWek = vbSunday Then .Font.Color = vbRed
If xWek = vbSaturday Then .Font.Color = vbBlue
If WorksheetFunction.CountIf(xHol, CLng(xDate)) > 0 Then
.Font.Color = vbRed
.Font.Bold = True
.Interior.Color = vbYellow
End If
End With
End With
Next xDate
End With
End Sub

閲覧数:
43
回答数:
1

違反報告

回答

1〜1件/1件中

min********さん

2020/4/601:24:45

こうゆうことですかね?

For i = 1 To 3
Worksheets("テンプレート").Copy before:=Worksheets(i)
With ActiveSheet
.Range("B2").Value = xName & i
.name = xName
.Range("B5").Value = Format(xDateS, "m月")
For xDate = xDateS To xDateE
xDay = Day(xDate)
xWek = Weekday(xDate, vbSunday)
With .Cells(xDay * 3 + 5, 2)
.Value = xDay
.Offset(, 1).Value = WeekdayName(xWek, True)
With .Resize(, 2)
If xWek = vbSunday Then .Font.Color = vbRed
If xWek = vbSaturday Then .Font.Color = vbBlue
If WorksheetFunction.CountIf(xHol, CLng(xDate)) > 0 Then

.Font.Color = vbRed

.Font.Bold = True
.Interior.Color = vbYellow
End If
End With
End With
Next xDate
End With
End Sub
Next i

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる