Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4897 / 76735 ←次へ | 前へ→

【77453】カレンダーに青太線
質問  桃太郎  - 15/10/13(火) 1:34 -

引用なし
パスワード
   こんにちは、よろしくお願いします。

Cell(4.5)に〇月1日のシリアルがあり、横長のカレンダーが置いてあります。
縦軸はメンバーのシフト表が32行目までありましたが、
事情により37行目まで増やしました。

7年ぐらい前にここで土日に青太線で囲むマクロを作っていただきました。
ところが今それを使うとまともに動かないことがわかりました。

原因がエクセルのバージョンのせいか、行を増やしたせいなのか
恥ずかしながらよくわかりません。

コードを見ていただいて修正していただけたら幸いです。

_________________________________________________________

Sub 罫線作成3()
' 罫線作成 Macro
' マクロ記録日 : 2006/3/13 ユーザー名 :


  Dim rngCurrent As Range
  Dim kei As Integer
 
  Set rngCurrent = ActiveSheet.Cells(4, 5)
 
  Application.ScreenUpdating = False
 
  With rngCurrent
    With .Resize(29, 31)
      .Borders(xlDiagonalDown).LineStyle = xlNone
      .Borders(xlDiagonalUp).LineStyle = xlNone
      With .Borders(xlEdgeLeft)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeTop)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeBottom)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeRight)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideVertical)
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
      End With
    End With
    '青太線の出力
    For kei = 0 To 30
      With .Offset(, kei).Resize(29)
        Select Case .Item(37, 1).Value
          Case Is = 7
            With .Borders(xlEdgeLeft)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeTop)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeBottom)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
      If kei = 30 Then
       With .Borders(xlEdgeRight)
        .Weight = xlMedium
        .ColorIndex = 11
       End With
             End If
       
      Case Is = 1
          
      If kei = 0 Then
       With .Borders(xlEdgeLeft)
        .Weight = xlMedium
        .ColorIndex = 11
       End With
      End If
            With .Borders(xlEdgeTop)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeBottom)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
            With .Borders(xlEdgeRight)
              .Weight = xlMedium
              .ColorIndex = 11
            End With
        End Select
      End With
    Next kei
  End With

  Set rngCurrent = Nothing
 
  Application.ScreenUpdating = True


以上です。自分でも数字をいじってみましたが、ますます動かなくなりました。
よろしくお願いします
0 hits

【77453】カレンダーに青太線 桃太郎 15/10/13(火) 1:34 質問[未読]
【77454】Re:カレンダーに青太線 β 15/10/13(火) 7:16 発言[未読]
【77455】Re:カレンダーに青太線 β 15/10/13(火) 7:48 発言[未読]
【77457】Re:カレンダーに青太線 β 15/10/13(火) 10:22 発言[未読]
【77466】遅くなりましてすいません 桃太郎 15/10/13(火) 20:36 発言[未読]
【77467】ちょっと原因がわかりました 桃太郎 15/10/13(火) 20:54 発言[未読]
【77468】Re:ちょっと原因がわかりました β 15/10/14(水) 0:39 発言[未読]
【77469】Re:ちょっと原因がわかりました 桃太郎 15/10/14(水) 3:02 お礼[未読]

4897 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free