Microsoft Office Forums - View Single Post - Pass sheet protected argument to Ribbon Control

BartH · 03-22-2018, 03:22 AM

Hi Debaser,

I tried your suggestion and I am half-way now: I added the SheetProtect ribbon command to my tab and it is responding to the protected state of the selected sheet.

For some reason when I reassign the onAction of the protectSheet button to the procedure that I use for my button, I get an error message:

Code in the customUI:

When I repurpose ProtectSheet with the procedures cbDoProtectSheet or doProtectSheet I get another message (with or without the name of the addin in the onAction):

I must be missing something... Suggestions?

The code for (cbD/d)oProtectSheet is:

Code:

Sub cbDoProtectSheet(control As IRibbonControl)
    doProtectSheet
End Sub
Sub doProtectSheet()

' NAME    : modProcessAndRenameFiles - doProtectSheet
' AUTHOR  : Bart Hoeksel, Nedcom IT
' PURPOSE : doProtectSheet
Dim strMsg As String
Dim xWs As Worksheet
Set xWs = Application.ActiveWorkbook.ActiveSheet

If strTmpPass = "" Then strTmpPass = strPss
On Error GoTo fout
Application.DisplayAlerts = False
If ActiveSheet.ProtectContents Then
    xWs.Unprotect strTmpPass
    strMsg = "Sheet protection is " & UCase(ActiveSheet.ProtectContents)
Else
    xWs.Protect Password:=strTmpPass, Userinterfaceonly:=True, DrawingObjects:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, Contents:=True
    xWs.EnableOutlining = True
    strMsg = "Sheet protection is " & UCase(ActiveSheet.ProtectContents)
End If
Application.DisplayAlerts = True

Debug.Print strMsg
Application.StatusBar = strMsg
Application.OnTime Now + TimeValue("00:00:06"), "clearStatus"
Set xWs = Nothing
Exit Sub

fout:
If Err.Number = 1004 Then
    strTmpPass = InputBox("What is the protection Password for this sheet?", "Get Password")
    If strTmpPass = "" Then
        Exit Sub
    Else
        Resume
    End If
Else
    MsgBox Err.Description, vbCritical, Err.Number
    Err.Clear
End If
Application.StatusBar = False
Set xWs = Nothing
End Sub

Grtz Bart