条件付き書式背景色確定

コード

Sub 条件付き書式背景色確定()

    Dim myRng As Range		'処理対象範囲
    Dim tmpRng As Variant	'一時保存用
    Dim henkoNo As Long		'処理個数カウント用
    
    If MsgBox("「$A$1」から「" & Cells.SpecialCells(xlLastCell).Address & _
        "」までを範囲として、条件付き書式の背景色を確定します。" & vbCrLf & vbCrLf & _
        "（条件付き書式の色でセルを塗りつぶし、条件付き書式を削除します。実行後は元に戻せません）" _
        , vbOKCancel, "「背景色確定」を実行しますか？") = vbCancel Then Exit Sub
    
    Set myRng = Range(Range("A1"), Cells.SpecialCells(xlLastCell))
    
    For Each tmpRng In myRng
	’塗りつぶしなし＝16777215でない場合処理
        If tmpRng.DisplayFormat.Interior.Color <> 16777215 Then	
            tmpRng.Interior.Color = tmpRng.DisplayFormat.Interior.Color
            henkoNo = henkoNo + 1
        End If
    Next tmpRng
    MsgBox henkoNo & "セルを処理しました。", vbInformation, "実行完了"
    
    Cells.FormatConditions.Delete
    
End Sub

解説