よねさんのWordとExcelの小部屋 なんでも掲示板

HOME HELP 新規作成 新着記事 ツリー表示 トピック表示 検索 過去ログ

ツリー一括表示

Nomal 横型カレンダー /ともちゃん (19/04/10(Wed) 18:46) #13366
Nomal Re[1]: 横型カレンダー /よねさん (19/04/11(Thu) 08:27) #13367
  └Nomal Re[2]: 横型カレンダー /ともちゃん (19/04/11(Thu) 10:57) #13368
    └Nomal Re[3]: 横型カレンダー /よねさん (19/04/11(Thu) 14:51) #13369
      └Nomal Re[4]: 横型カレンダー /ともちゃん (19/04/12(Fri) 17:29) #13371


親記事 / ▼[ 13367 ]
■13366 / 親階層)  横型カレンダー
□投稿者/ ともちゃん -(2019/04/10(Wed) 18:46:14)
    2019/04/10(Wed) 18:47:01 編集(投稿者)
    2019/04/10(Wed) 18:46:55 編集(投稿者)

    こんばんは。
    横型カレンダー参考に勉強させていただいております。
    横型カレンダーが列方向に月ごとに整列していますが、ガンチャートのように1行(月表示と曜日表示は今の表示のまま2段で。)で指定日まで表示可能でしょうか?ご伝授願います。よろしくお願いいたします。
[ □ Tree ] 返信/引用返信 削除キー/

▲[ 13366 ] / ▼[ 13368 ]
■13367 / 1階層)  Re[1]: 横型カレンダー
□投稿者/ よねさん -(2019/04/11(Thu) 08:27:57)
      For i = 1 To 12 と  For j = 1 To 32 の2重ループにしていますが、
    これは月ごとに行を変えているためです。
    1行で良いのなら、開始日から終了日までのループだけで済みます。
    以下のように書き換えてみました。
    
    Sub calendar_make4()
    'カレンダー作成
    '
        Dim sh1 As Worksheet
        Dim i As Integer, j As Integer
        Dim myDay As Date
        Dim myPs As Range
        Dim Holiday As Range
        Dim iCol As Variant, fCol As Variant
        Dim myFlg As Boolean
        Dim sYear As Integer, eYear As Integer
        Dim sMonth As Integer, eMonth As Integer
        Dim sDay As Integer, eDay As Integer
         Dim gyokan As Long, mycnt As Long
         Dim cnt As Long
    
    
        Set sh1 = Worksheets("カレンダー4")
        Set Holiday = Worksheets("祝日").Range("A1:A84")
    
        Application.ScreenUpdating = False
      
        gyokan = 4  '行間隔
    
        With sh1
            '着色クリア
            With .Range("D4:BZ8")  '適切な範囲にすること
                .ClearContents
                .Interior.ColorIndex = xlNone
                .Font.ColorIndex = 0
    
            End With
    
            '設定年月日
                sYear = Year(.Range("E2").Value)
                sMonth = Month(.Range("E2").Value)
                sDay = Day(.Range("E2").Value)
                eYear = Year(.Range("E3").Value)
                eMonth = Month(.Range("E3").Value)
                eDay = Day(.Range("E3").Value)
    
                i = 1
                For j = 1 To .Range("E3").Value - .Range("E2").Value + 1
                    '入力する日付
                   myDay = DateSerial(sYear, sMonth, sDay + cnt)
                    cnt = cnt + 1
                   
    
                    '月、日にちを入力
                    .Cells(2 + gyokan * i, 4).Value = Month(.Cells(2 + gyokan * i, 5).Value) & "月"
                    .Cells(2 + gyokan * i + 1, 4).Value = "曜日"
    
     '               Set myPs = .Cells(2 + gyokan * i, 4 + j)    '入力するセル ここを基準に設定しています
                    Set myPs = .Cells(2 + gyokan, 4 + j)     '入力するセル ここを基準に設定しています
                    myPs.Value = myDay
                    myPs.NumberFormatLocal = "d"    '表示形式を"d"に設定しています。
    
                    '曜日を入力
                    myPs.Offset(1, 0).Value = Format(myDay, "aaa")
                    '土日check
                    myFlg = False
                    Select Case myPs.Offset(1, 0).Value
                        Case "土"
                            iCol = 34    '塗りつぶしの色番号
                            fCol = 5    'フォントの色番号
                            myFlg = True
                        Case "日"
                            iCol = 36
                            fCol = 3
                            myFlg = True
                        End Select
    
                      '祝日check
                      If WorksheetFunction.CountIf(Holiday, myPs.Value) = 1 Then
                          iCol = 40
                          fCol = 3
                          myFlg = True
                      End If
                      '着色  土日祝日の時(myFlg = True)に実行
                      If myFlg = True Then
                        .Range(myPs, myPs.Offset(1, 0)).Interior.ColorIndex = iCol
                        .Range(myPs, myPs.Offset(1, 0)).Font.ColorIndex = fCol
                      End If
    
                  Next j
    
    
            End With
    
            Application.ScreenUpdating = True
    
    End Sub
    
    
    
    

[ 親 13366 / □ Tree ] 返信/引用返信 削除キー/

▲[ 13367 ] / ▼[ 13369 ]
■13368 / 2階層)  Re[2]: 横型カレンダー
□投稿者/ ともちゃん -(2019/04/11(Thu) 10:57:09)
    よねさん
    おはようございます。お返事ありがとうございます。
    何度もやりましたがなかなかうまくいかず…。
    助かりました!!!本当にありがとうございます。
    もうひとつ伝授していただきたいのですが、月始まりの1日の上の行に月を表示することも可能ですか?
[ 親 13366 / □ Tree ] 返信/引用返信 削除キー/

▲[ 13368 ] / ▼[ 13371 ]
■13369 / 3階層)  Re[3]: 横型カレンダー
□投稿者/ よねさん -(2019/04/11(Thu) 14:51:15)
    曜日を入力の前に、下記のように月を入力のコードを入れてください。
                    '月を入力
                    If Day(myDay) = 1 Then
                        myPs.Offset(-1, 0).Value = Month(myDay) & "月"
                    End If
                    
                    '曜日を入力
    
    ---以上---
    

[ 親 13366 / □ Tree ] 返信/引用返信 削除キー/

▲[ 13369 ] / 返信無し
■13371 / 4階層)  Re[4]: 横型カレンダー
□投稿者/ ともちゃん -(2019/04/12(Fri) 17:29:06)
    よねさん
    無事に作成できました!!!
    本当にありがとうございます。
[ 親 13366 / □ Tree ] 返信/引用返信 削除キー/


Pass/

HOME HELP 新規作成 新着記事 ツリー表示 トピック表示 検索 過去ログ

- Child Tree -