1

次のコードを探しています。

シートは現在ロックされています (ロックされたセル選択が有効になっています)。

VBAは、21、22などの行全体が選択されているかどうかを検出し、シートの保護を自動的に解除します。

それから：

これらの正確な行が削除された場合..シートは自動的に再び保護します。

ユーザーがこれらの行の選択を解除すると、シートは再び保護されます。

(これは特定の行の削除を行うための設計です)

非常に大雑把に：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    IF Rows("1:1").Select AND/OR Rows("2:2").Select AND/OR Rows("3:3").Select then
        ActiveSheet.Unprotect
    End If

    ActiveCell.Row.Delete
    ActiveSheet.Protect

End Sub
4

1 に答える 1

1

Application.enableEvents = True最初に設定することを忘れないでください

編集議論中のOPの新しい仕様として変更されたコード

制限: 行全体 (行全体を選択できるようにするには、すべてのセルのロックを解除する必要があります)

' remember the event's name is `Worksheet_SelectionChange`
' NOT Worksheet1_SelectionChange
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Unprotect
    ' the rows to be selected
    Dim row1 As Range
    Dim row2 As Range
    Dim row3 As Range
    Dim mergedRange As Range
    Set row1 = Me.Rows("1:1")
    Set row2 = Me.Rows("3:3")
    Set row3 = Me.Rows("5:5")
    Dim found As Boolean
    Dim Match As Boolean
    Set mergedRange = Application.Union(row1, row2)
    Set mergedRange = Application.Union(mergedRange, row3)
    Match = False


    ' check if it selects only 1 row
    If Target.Areas.Count <> 1 Then
        ActiveSheet.Protect
        Exit Sub
    End If


    ' check if it's select the first 500 rows
    If Target.Areas.Item(1).Row > 0 And Target.Areas.Item(1).Row <= 500 Then
        'check if it's selecting the WHOLE row
        If Me.Rows(Target.Areas.Item(1).Row & ":" & Target.Areas.Item(1).Row).Areas.Item(1).Count = Target.Areas.Item(1).Count Then
            ' check if the "B" Column of this row's backgound color is blue
            If Me.Cells(Target.Areas.Item(1).Row, 2).Interior.Color = RGB(197, 217, 241) Then
                Match = True
            End If
        End If
    End If


    If Match Then

        'MsgBox "ActiveSheet.Unprotect"
        ActiveSheet.Unprotect
    Else
        Debug.Print "notMatch"
        'ActiveCell.Row.Delete
       ActiveSheet.Protect
    End If


End Sub
于 2013-01-31T09:21:59.777 に答える