Excel VBA質問箱 IV

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

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


4893 / 76735 ←次へ | 前へ→

【77457】Re:カレンダーに青太線
発言  β  - 15/10/13(火) 10:22 -

引用なし
パスワード
   ▼桃太郎 さん:

申し上げたように、要件を具体的に説明いただければ、適切な回答も可能かと思いますが
以下は、想像をたくましくしたコード案です。
領域や、罫線要件に誤解があるかもしれませんが。

Sub test()

  Dim rngCurrent As Range
  Dim col As Range
  Dim chk As Variant
  
  Set rngCurrent = Range("D4:AH32")
  
  Application.ScreenUpdating = False

  '領域の罫線を処理前に削除
  rngCurrent.Borders.LineStyle = xlNone
  '左端、右端含めて、縦に HairLine
  With rngCurrent.Offset(, -1).Resize(, rngCurrent.Columns.Count + 2).Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
  End With
  '領域上端、下端に細実線
  With rngCurrent.Borders(xlEdgeTop)
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With rngCurrent.Borders(xlEdgeBottom)
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  '土日枠
  For Each col In rngCurrent.Columns
    chk = Cells(40, col.Column).Value
    Select Case chk
      Case 1, 7
        '列上端、下端に青太線
        With col.Borders(xlEdgeTop)
          .Weight = xlMedium
          .ColorIndex = 11
        End With
        With col.Borders(xlEdgeBottom)
          .Weight = xlMedium
          .ColorIndex = 11
        End With
        '左あるいは右に青太線
        With col.Borders(IIf(chk = 1, xlEdgeRight, xlEdgeLeft))
          .Weight = xlMedium
          .ColorIndex = 11
        End With
    End Select
  Next
  
  Set rngCurrent = Nothing

  Application.ScreenUpdating = True

End Sub

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 お礼[未読]

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