VBA 条件書式の削除

選択範囲の条件付き書式の削除

Option Explicit

'=== 高速化 ===
Private Sub EnterFast(Optional ByRef prevCalc As XlCalculation = xlCalculationAutomatic)
    With Application
        prevCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayStatusBar = True
        .StatusBar = "条件付き書式 処理中…"
    End With
End Sub

Private Sub ExitFast(ByVal prevCalc As XlCalculation)
    On Error Resume Next
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = prevCalc
        .StatusBar = False
    End With
End Sub

Public Sub CF_DeleteAll_OnSelection()
    On Error GoTo EH

    '=== 初期チェック ===
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択してください。", vbExclamation
        Exit Sub
    End If

    '=== 固定参照 ===
    Dim ws As Worksheet
    Dim rng As Range
    Set ws = ActiveSheet
    Set rng = Selection

    '=== 保護／存在チェック ===
    If ws.ProtectContents Then
        MsgBox "このシートは保護されています。選択範囲の条件付き書式を削除できません。", vbExclamation
        Exit Sub
    End If
    If rng.FormatConditions.count = 0 Then Exit Sub

    '=== 高速化モード ===
    Dim prev As XlCalculation
    Dim didFast As Boolean
    EnterFast prev
    didFast = True

    '=== 本処理 ===
    rng.FormatConditions.Delete

Finally:
    If didFast Then ExitFast prev
    Exit Sub

EH:
    MsgBox "CF削除（選択）エラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
    Resume Finally
End Sub

シート内の条件付き書式の削除

Option Explicit

'=== 高速化 ===
Private Sub EnterFast(Optional ByRef prevCalc As XlCalculation = xlCalculationAutomatic)
    With Application
        prevCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayStatusBar = True
        .StatusBar = "条件付き書式 処理中…"
    End With
End Sub

Private Sub ExitFast(ByVal prevCalc As XlCalculation)
    On Error Resume Next
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = prevCalc
        .StatusBar = False
    End With
End Sub


Public Sub CF_DeleteAll_OnSheet()
    On Error GoTo EH

    ' ワークシート前提
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub

    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' 保護チェック
    If ws.ProtectContents Then
        MsgBox "このシートは保護されています。条件付き書式を削除できません。", vbExclamation
        Exit Sub
    End If

    ' ルールがなければ終了
    If ws.Cells.FormatConditions.count = 0 Then Exit Sub

    ' 高速化（開始／終了は didFast で管理）
    Dim prev As XlCalculation
    Dim didFast As Boolean
    EnterFast prev
    didFast = True

    ' 削除本体
    ws.Cells.FormatConditions.Delete

Finally:
    If didFast Then ExitFast prev
    Exit Sub

EH:
    MsgBox "CF削除（シート）エラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
    Resume Finally
End Sub

コメント