Регистрировать каждый раз, когда лист защищен или не защищен в Excel VBA - PullRequest
0 голосов
/ 18 июня 2020

Я ищу способ записать на другой лист в Excel каждый раз, когда кто-то защищает или снимает защиту листа в моей Рабочей тетради. Я хочу, чтобы он регистрировал, был ли он защищен или незащищен, и время рядом с ним. Спасибо!

Прямо сейчас у меня есть следующий код для защиты или снятия защиты листа с помощью более удобной кнопки:

If ActiveWorkbook.Sheets("Calendar").ProtectContents = True Then
    ActiveSheet.Unprotect
    MsgBox "Sheet unprotected"
    Exit Sub
End If

ActiveSheet.Protect ("password")
MsgBox "Calendar has been protected"

Ответы [ 3 ]

0 голосов
/ 18 июня 2020

Google послал бы вас сюда: https://www.ozgrid.com/forum/index.php?thread / 43816-unprotect-worksheet-event / , автор даже дает вам образец: https://www.ozgrid.com/forum/core/index.php?attachment / 1082834-52719-xls /

Это не 100% защита от ошибок, так как обработчик событий не может определить, когда пользователь отменяет диалоговое окно защиты / снятия защиты.

Эта книга

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    StartEventListiner False

End Sub

Private Sub Workbook_Open()

    StartEventListiner True

End Sub

Модуль

Option Explicit
Public g_clsEvnt As CProtectEvt

Public Sub StartEventListiner(Action As Boolean)

    If Action Then
        Set g_clsEvnt = New CProtectEvt
    Else
        Set g_clsEvnt = Nothing
    End If

End Sub

Класс

Option Explicit

Public WithEvents cbbProtect As CommandBarButton

Private Sub m_ProtectControls(State As Boolean)

    Dim objX As OLEObject

    On Error Resume Next
    For Each objX In ActiveSheet.OLEObjects
        objX.Object.Enabled = State
    Next

End Sub

Private Sub cbbProtect_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)

    m_ProtectControls (InStr(1, Ctrl.Caption, "Un&protect", vbTextCompare) > 0)

End Sub

Private Sub Class_Initialize()

    On Error Resume Next

    ' hook into Tools > Protection > Protect Sheet event
    Set cbbProtect = Application.CommandBars.FindControl(msoControlButton, ID:=893)

End Sub
0 голосов
/ 18 июня 2020

Переключить и зарегистрировать защиту рабочего листа

  • Код регистрирует защиту только при использовании кнопки (которой назначено toggleWorksheetProtection_Click) или при запуске toggleWorksheetProtection_Click из VBE.
  • Скопируйте полный код в стандартный модуль (например, Module11).
  • Отрегулируйте значения пяти const муравьев.
  • ThisWorkbook относится в книгу, содержащую этот код.
  • Дополнительно измените формат даты в writeLogRow.

Код

Option Explicit

Sub toggleWorksheetProtection_Click()
    ' Constants
    Const srcName As String = "Calendar"
    Const tgtName As String = "Log"
    Const tgtCol As Variant = 1
    Const msgProtect As String = "Sheet protected."
    Const msgUnProtect As String = "Sheet unprotected."
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    ' Other Variables
    Dim src As Worksheet: Set src = wb.Worksheets(srcName)
    Dim tgt As Worksheet: Set tgt = wb.Worksheets(tgtName)
    Dim msg As String
    ' Protection
    If src.ProtectContents Then
        src.Unprotect: msg = msgUnProtect
    Else
        src.Protect: msg = msgProtect
    End If
    ' Log
    Dim cel As Range
    Set cel = getEmptyCell(tgt, tgtCol)
    Call writeLogRow(cel, msg)

End Sub

Function getEmptyCell(Sheet As Worksheet, ByVal writeColumn As Variant)
    Dim cel As Range
    Set cel = Sheet.Columns(writeColumn).Find("*", , xlValues, , , xlPrevious)
    If Not cel Is Nothing Then
        Set cel = cel.Offset(1)
    Else
        Set cel = Sheet.Cells(1, writeColumn)
    End If
    Set getEmptyCell = cel
End Function

Sub writeLogRow(logRange As Range, ByVal logMessage As String)
    Dim logDate As Date: logDate = Now
    logRange.Value = logDate
    logRange.NumberFormat = "mm/dd/yyyy hh:mm:ss (ddd)"
    logRange.Offset(, 1).Value = logMessage
End Sub
0 голосов
/ 18 июня 2020

Excel VBA не имеет события, которое может определить, является ли лист защищенным / незащищенным.

Не стреляйте в мессенджер.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...