目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
103 / 263 ←次へ | 前へ→

【173】7×7マスのカレンダー
Excel  Jaka  - 06/12/26(火) 10:16 -

引用なし
パスワード
   全ての月(曜を日含む、7×7マス)の位置を一々決めなければならない手間がありますが、マスの位置をの変則に好き勝手な場所に設定できるようにこんな感じにしてみました。
B1セルに年号が入っているとします。
年号の不具合チェックはしてません。
祝日、振替休日も入れてません。
土日だけ色を変えました。
一応罫線も入ってます。

Sub カレンダー3()
 Const 一月 As String = "B4:H10", 二月 As String = "K4:Q10", 三月 As String = "B14:H20"
 Const 四月 As String = "K14:Q20", 五月 As String = "B24:H30", 六月 As String = "K24:Q30"
 Const 七月 As String = "B34:H40", 八月 As String = "K34:Q40", 九月 As String = "B44:H50"
 Const 十月 As String = "K44:Q50", 十一月 As String = "M53:S59", 十二月 As String = "B55:H61"

 Dim TB(0 To 5, 0 To 6), RgTB As Variant, WekN As Long, YMD_C As Date
 Dim Rgst1 As Variant, Rgst2 As String, WeekTL As Variant, Ct As Long
 Dim Nen As Long, EndD As Long, No As Long, WkRwo As Long, WkCol As Long

 WeekTL = Array("日", "月", "火", "水", "木", "金", "土")
 RgTB = Array(一月, 二月, 三月, 四月, 五月, 六月, _
        七月, 八月, 九月, 十月, 十一月, 十二月)
 Application.ScreenUpdating = False
 Nen = Range("B1").Cells(1).Value  'B1に年号が入っているとして。
                   'B1が結合セルの左上に値すれば、結合セル可。
 Range("B2:T62").Clear 'Cells.Clear
 'Range("B2:T62").ClearComments  '変動祝日を休日表無しで、条件付書式にした場合
 Range("B1").Cells(1).Value = Nen

 For Each Rgst1 In RgTB
   Ct = Ct + 1
   YMD_C = Nen & "/" & Ct & "/1"
   WekN = Weekday(YMD_C)
   EndD = Day(DateSerial(Year(YMD_C), Month(YMD_C) + 1, 0))
   With Range(Rgst1)
     '月
     .Cells(1).Offset(-1).Value = Month(YMD_C) & "月"
     '週タイトル記入、文字センター、色黄色
     With .Rows(1)
       .Value = WeekTL
       .Rows(1).HorizontalAlignment = xlCenter
       .Rows(1).Interior.ColorIndex = 6
     End With
     .Columns(1).Font.ColorIndex = 3 '文字赤
     .Columns(7).Font.ColorIndex = 41 '文字青
     'セル範囲タイトル分縮小
     Rgst2 = .Resize(.Rows.Count - 1).Offset(1).Address(0, 0)
     With Range(Rgst2)
       For i = 0 To EndD - 1
        No = WekN + i - 1
        WkRwo = Fix(No / 7)
        WkCol = No Mod 7
        TB(WkRwo, WkCol) = i + 1
       Next
       .Value = TB
     End With
   End With
   Erase TB
   Call 罫線22(CStr(Rgst1))
 Next
 WeekTL = Empty: RgTB = Empty
 Application.ScreenUpdating = True
End Sub

Sub 罫線22(Rgst As String)
 With Range(Rgst)
   '.Borders.LineStyle = 1 'OK
    .Borders.Weight = 2 'xlThick普通=2 'xlMedium太線=3
              'xlHairline細=1 'xlThick極太線=4
    .Rows(1).BorderAround (9)
    .BorderAround (1) '細=0 普通=1 点線1=2 点線2=3 点線3=4 点線4=5
             '普通=6,7,8,10,11,12 2重=9
             '太斜点=13 14X 15X 16X 17X 18X 19X 20X
 End With
End Sub

3,705 hits

【37】不特定な祝日を求めるエクセル関数とマクロ関数。 Jaka 03/10/28(火) 11:29 Excel[未読]
【38】文中間違い訂正。 Jaka 03/10/29(水) 12:14 Excel[未読]
【59】[管理者削除] [未読]
【88】一応、全部?の祝日です。 Jaka 05/2/28(月) 11:27 Excel[未読]
【89】Re:一応、全部?の祝日です。 ponpon 05/3/6(日) 20:53 Excel[未読]
【138】祝日表作成時の振替休日について Jaka 06/2/21(火) 13:50 Excel[未読]
【146】カレンダーコントロールみたなような・・・。 Jaka 06/5/22(月) 12:55 Excel[未読]
【147】標準モジュールのコード Jaka 06/5/22(月) 12:56 Excel[未読]
【173】7×7マスのカレンダー Jaka 06/12/26(火) 10:16 Excel[未読]
【182】祝祭日も入れてみた。 Jaka 07/1/9(火) 9:53 Excel[未読]
【187】↑の注意点。 Jaka 07/1/31(水) 10:46 Excel[未読]
【220】修正点 Jaka 07/12/5(水) 12:44 Excel[未読]
【221】祝日表をまとめてみた。 Jaka 07/12/6(木) 9:45 Excel[未読]
【227】Re:祝日表をまとめてみた。 VBWASURETA 08/1/24(木) 9:57 全般[未読]
【267】表に位置について。 Jaka 11/2/14(月) 16:59 Excel[未読]

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
103 / 263 ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free