VBA 書式クリア

値は保持して書式だけクリア

'==============================
' 書式：値は保持して書式だけクリア
'==============================
Public Sub ClearFormatsKeepValues()
    Dim rng As Range
    If Not TryGetRangeSelection(rng) Then Exit Sub
    If rng.Worksheet.ProtectContents Then
        MsgBox "このシートは保護されています。書式を変更できません。", vbExclamation
        Exit Sub
    End If

    On Error GoTo EH
    rng.ClearFormats
    Exit Sub
EH:
    MsgBox "書式リセットでエラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
End Sub

'==============================
' 内部ヘルパー
'==============================
Private Function TryGetRangeSelection(ByRef rngOut As Range) As Boolean
    On Error GoTo EH
    Dim rng As Range
    Set rng = Nothing
    On Error Resume Next
    Set rng = ActiveWindow.RangeSelection
    On Error GoTo EH

    If rng Is Nothing Then
        MsgBox "セル範囲を選択してください。", vbExclamation
        TryGetRangeSelection = False
    Else
        Set rngOut = rng
        TryGetRangeSelection = True
    End If
    Exit Function
EH:
    MsgBox "選択範囲の取得でエラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
    TryGetRangeSelection = False
End Function

罫線のみ全クリア

'==============================
' 罫線のみ全クリア（背景やフォントは保持）
'==============================
Public Sub ClearBordersOnly()
    Dim rng As Range
    If Not TryGetRangeSelection(rng) Then Exit Sub
    If rng.Worksheet.ProtectContents Then
        MsgBox "このシートは保護されています。罫線を変更できません。", vbExclamation
        Exit Sub
    End If

    On Error GoTo EH
    Dim b As XlBordersIndex
    For b = xlDiagonalDown To xlInsideHorizontal
        rng.Borders(b).LineStyle = xlNone
    Next b
    Exit Sub
EH:
    MsgBox "罫線クリアでエラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
End Sub

'==============================
' 内部ヘルパー
'==============================
Private Function TryGetRangeSelection(ByRef rngOut As Range) As Boolean
    On Error GoTo EH
    Dim rng As Range
    Set rng = Nothing
    On Error Resume Next
    Set rng = ActiveWindow.RangeSelection
    On Error GoTo EH

    If rng Is Nothing Then
        MsgBox "セル範囲を選択してください。", vbExclamation
        TryGetRangeSelection = False
    Else
        Set rngOut = rng
        TryGetRangeSelection = True
    End If
    Exit Function
EH:
    MsgBox "選択範囲の取得でエラー：" & Err.Description & "（" & Err.Number & "）", vbCritical
    TryGetRangeSelection = False
End Function

コメント