1

Excelレポートのすべてのシートですべての塗りつぶされたセル(のみ)をロックする方法はありますか?? これはエクセルのプロパティがあれば嬉しいです。なければvbaコードでも構いません。vba コードが見つかりましたが、シート名を指定する必要があります。このように、シートが多すぎて、すべてのシートの名前を付けることができません。

VBA コード:

  Private Sub Workbook_AfterSave(ByVal Success As Boolean)
For Each cl In Sheets("Sheet1").Cells
    If cl = blank Then
        cl.Locked = False
        Else
        cl.Locked = True
    End If
Next
Sheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Sheet1").EnableSelection = xlUnlockedCells
End Sub

これに対するより良い方法を提案してください。

前もって感謝します。

4

1 に答える 1

0

Filled Cells私が仮定することにより、Cell はFormulasまたはConstantsまたはを持っていCommentsます。

コードに組み込むことができるこの例を参照してください。これはすべてのセルをループするのではなく、SpecialCells

未テスト

Sub Sample()
    Dim Rng As Range
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        .Cells.Locked = False

        On Error Resume Next

        Set Rng = .Cells.SpecialCells(xlCellTypeConstants)
        Rng.Locked = True

        Set Rng = .Cells.SpecialCells(xlCellTypeFormulas)
        Rng.Locked = True

        Set Rng = .Cells.SpecialCells(xlCellTypeComments)
        Rng.Locked = True

        On Error GoTo 0
    End With
End Sub

すべてのワークシートに適用する場合は、すべてのワークシートをループするだけです

例えば

Sub Sample()
    Dim Rng As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Cells.Locked = False

            On Error Resume Next

            Set Rng = .Cells.SpecialCells(xlCellTypeConstants)
            Rng.Locked = True

            Set Rng = .Cells.SpecialCells(xlCellTypeFormulas)
            Rng.Locked = True

            Set Rng = .Cells.SpecialCells(xlCellTypeComments)
            Rng.Locked = True

            On Error GoTo 0
        End With
    Next
End Sub

フォローアップ（コメントから）

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Rng As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws

            .UnProtect

            .Cells.Locked = False

            On Error Resume Next

            Set Rng = .Cells.SpecialCells(xlCellTypeConstants)
            Rng.Locked = True

            Set Rng = .Cells.SpecialCells(xlCellTypeFormulas)
            Rng.Locked = True

            Set Rng = .Cells.SpecialCells(xlCellTypeComments)
            Rng.Locked = True

            On Error GoTo 0

           .Protect
           .EnableSelection = xlUnlockedCells
        End With
    Next
End Sub
于 2013-02-20T07:19:06.917 に答える