シートの中身を疑似ダークモードにするマクロ

シートの内容も疑似的にダークモードにするマクロです。セルのスタイルを新規作成して、全セルに適用します。また、そのままの色で印刷されないように印刷設定を行います。

こんな感じになります

以下のトピックと連動しています。仕掛けや解除方法などについては関連トピックを御覧ください。

Sub ダークモードシート化()
  Const nameDM As String = "標準DM"
  Dim styDM As Style
  Dim itm

  On Error Resume Next
  Set styDM = ActiveWorkbook.Styles(nameDM)
  On Error GoTo 0
  If styDM Is Nothing Then
    Set styDM = ActiveWorkbook.Styles.Add(Name:=nameDM)
    With styDM
      '変更対象外の書式
      .IncludeNumber = False
      .IncludeAlignment = False
      .IncludeProtection = False
      'ダークグレイのけい線描画
      For Each itm In Array(xlBottom, xlLeft, xlRight, xlTop)
        With .Borders(itm)
          .LineStyle = xlContinuous
          .ThemeColor = xlThemeColorDark1
          .TintAndShade = -0.7
          .Weight = xlThin
        End With
      Next itm
      'ダークモード背景色
      With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = 0
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.9
        .PatternTintAndShade = 0
      End With
      '文字を白に
      With .Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 1
      End With
    End With
  End If
  'シート全体にスタイルを適用
  Cells.Style = styDM
  '白黒印刷の設定
  ActiveSheet.PageSetup.BlackAndWhite = True
  Set styDM = Nothing
End Sub