[[20240618144747]]　『条件付き書式の書式のみ残す方法』（クリーナー７）　ページの最後に飛ぶ

『条件付き書式の書式のみ残す方法』（クリーナー７）

VBAを使用して条件付き書式で設定された書式をそのまま残して条件付き書式の削除を行いたいです。
以下のサンプルを試したところ、罫線は対象に含まれておらず削除されてしまいました。
文字色は背景色などと同様に罫線も残す方法はないでしょうか？

https://lenoco.tokyo/?p=1838
<サンプル>
Sub Main()

    Dim rng As Range
    '条件付き書式が設定されているところは書式のみ残し条件付き書式を削除
    For Each rng In ActiveSheet.UsedRange.Cells
        ' DisplayFomatとFormatを比較して異なっていたらDisplayFomatの色に合わせる
        '文字色
        If rng.DisplayFormat.Font.Color <> rng.Font.Color Then
            rng.Font.Color = rng.DisplayFormat.Font.Color
        End If
        '太字
        If rng.DisplayFormat.Font.Bold <> rng.Font.Bold Then
            rng.Font.Bold = rng.DisplayFormat.Font.Bold
        End If
        '背景色
         If rng.DisplayFormat.Interior.Color <> rng.Interior.Color Then
            rng.Interior.Color = rng.DisplayFormat.Interior.Color
        End If
    Next
    ActiveSheet.UsedRange.FormatConditions.Delete        '条件付き書式を削除
End Sub
<ここまで>

罫線なので"Borders.LineStyle"、"Borders.Color"を追加してみたのですが、
いずれの値もNULLになっていて設定されませんでした。
<追加>

        '罫線
        If rng.DisplayFormat.Borders.LineStyle <> rng.Borders.LineStyle Then
            rng.Borders.LineStyle = rng.DisplayFormat.Borders.LineStyle
        End If

        '罫線色
        If rng.DisplayFormat.Borders.Color <> rng.Borders.Color Then
            rng.Borders.Color = rng.DisplayFormat.Borders.Color
        End If
<ここまで>

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

 Bordersはコレクションなので、Borders(xlEdgeBottom) というように
 1本づつ指定して処理しないといけないです。

    Sub sample()
      CopyBoder Range("A1").DisplayFormat.Borders, Range("C1").Borders
    End Sub

    Sub CopyBoder(BodersFrom As Borders, BodersTo As Borders)
      Dim bf As Border, bt As Border
      For Each n In Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlDiagonalDown, xlDiagonalUp)
          Set bf = BodersFrom(n)
          Set bt = BodersTo(n)
          If bf.LineStyle = xlLineStyleNone Then
             bt.LineStyle = xlLineStyleNone
          Else
             bt.LineStyle = bf.LineStyle
             bt.Weight = bf.Weight
             bt.Color = bf.Color
          End If
      Next
    End Sub
（´・ω・`） 2024/06/18(火) 16:00:29

（´・ω・`）さん
ありがとうございます。
罫線は4辺と対角線の指定が必要なのですね。
サンプルのプログラムで罫線を含めて書式を残すことができました。
（クリーナー７） 2024/06/18(火) 16:37:40

 めも
　https://ooltcloud.sakura.ne.jp/blog/201508/article_16020303.html

  Sub test()
    Dim wsh As Object, cmd As String
    Dim r As Range
    Dim dic As Object

    Set wsh = CreateObject("WScript.Shell")
    cmd = "Powershell -sta -command " _
        & """" _
          & " Add-Type -an System.Windows.Forms; " _
          & " $a = [System.Windows.Forms.Clipboard]::GetData('HTML Format');  " _
          & " [System.Windows.Forms.Clipboard]::Clear(); " _
          & " [System.Windows.Forms.Clipboard]::SetData('HTML Format', $a); " _
        & """"

    Set dic = CreateObject("scripting.dictionary")

    With Worksheets("Sheet1").UsedRange
        For Each r In .Rows
            dic(dic.Count) = r.Formula
        Next

        .Copy
        wsh.Run cmd, 0, True
        .Worksheet.Paste .Cells
        .Value = Application.Index(dic.items, 0, 0)
    End With

 End Sub
（マナ） 2024/06/18(火) 22:40:39

 お二方の貴重なTipsの紹介ありがとうございます。 参考にさせていただきます。

 ところで、質問者さんの紹介されたサイトにも書かれていますが、
 officeクリップボードを使って、貼り付けすると条件付き書式ではなく固定的な書式として張り付くんですね。
  (officeクリップボードはすべてHTMLテキストによる処理との記憶がありますが、それが功を奏しているんでしょうか。)

 もし今回のVBAコードの保存場所などを忘れてしまっても、手動でできそうですね。(罫線も含み）
 ただし、上記処理では、数式が値になってしまうので、
 予め別の箇所に元のコピーを持って置き（通常のコピーペイスト）、
 最後に、もう一度、そこから「数式のみ貼り付け」処理をかぶせればいいんでしょうね。
（xyz） 2024/06/19(水) 12:33:18

コメント返信：

[ 一覧(最新更新順) ]

[[20240618144747]] 『条件付き書式の書式のみ残す方法』（クリーナー７） ページの最後に飛ぶ

[[20240618144747]]　『条件付き書式の書式のみ残す方法』（クリーナー７）　ページの最後に飛ぶ