Standard Protect Sheet Button In Custom Excel Ribbon

I have a custom ribbon I've built in excel using the custom UI editor.  I would like to add the standard toggle button to protect the sheet to this custom ribbon.  Of course I can just create a button that looks like the protect sheet button with a protect sheet sub behind it but it doesn't toggle between protect and unprotect.

Is is possible to add the standard toggle to the custom ribbon using xml?  If so, how?

If it is possible, is it possible to protect the sheet using that button without having the extra box to pop up asking what type of protection to do (edit or select protected cells for example)?
rmc71291Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
If a form control button is acceptable then just assign this macro to it.

Sub ProtectSheetToggle()
    If Sheets("Sheet1").Buttons("Button 1").Caption = "Protect Sheet" Then
        Sheets("Sheet1").Buttons("Button 1").Caption = "UnProtect Sheet"
        Sheets("Sheet1").Protect Password:="Password"
    Else
        Sheets("Sheet1").Unprotect Password:="Password"
        Sheets("Sheet1").Buttons("Button 1").Caption = "Protect Sheet"
    End If
End Sub

Open in new window

0
rmc71291Author Commented:
Sorry but no. I had that at first but when I learned about custom ribbons I really liked that and went that route to make it look more professional.
0
Martin LissOlder than dirtCommented:
OK, give me an hour or so and I'll be back.
0
Exploring SharePoint 2016

Explore SharePoint 2016, the web-based, collaborative platform that integrates with Microsoft Office to provide intranets, secure document management, and collaboration so you can develop your online and offline capabilities.

Martin LissOlder than dirtCommented:
I don't know what's going on here. A couple of times I've updated a workbook with some ribbon XML code and tested the worksheet and then saved it, only to have it revert to the previous state when I reopen it. It's been frustrating but I'm still working on it.
0
Martin LissOlder than dirtCommented:
OK I think this is what you want. You'll find a protect sheet toggle button in a custom tab named "My Custom Tab". The imageMso  isn't correct but I assume you can correct that. Here's the ribbon xml and the workbook is attached.
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="RibbonUI_onLoad">
<ribbon startFromScratch="false">
<tabs>
<tab id="customTab" label="My Custom Tab">
<group id="customGroup" label="Custom Group">
<toggleButton id="customButton1" imageMso="HappyFace" size="large" onAction="ProtectSheetToggle" getLabel="GetDownloadLabel"  />
</group>
</tab>
</tabs>
</ribbon>
</customUI> 

Open in new window

Q-28663964.xlsm
0
rmc71291Author Commented:
Wow!  Sorry it took me so long to respond but this is almost exactly what I needed.  The only issue is the password part.  It causes a Password dialog box to open when I perform other macros.  I don't need a password at all to unprotect the sheet.  Is there anyway to modify the code to remove the password part?
0
Martin LissOlder than dirtCommented:
In the code in Module1 you'll find the following and removing the Password:="Password" part from lines 10 and 12 should solve your problem, although when I press the happy face the second time to unprotect the sheet I don't get a dialog. BTW you can also delete line 7.
Sub ProtectSheetToggle(control As IRibbonControl, pressed As Boolean)
     
    gbProtected = pressed
        
    gxRibbonUI.InvalidateControl "customButton1"
    
    Debug.Print pressed
    If pressed Then
    
        ActiveSheet.Protect Password:="Password"
    Else
        ActiveSheet.Unprotect Password:="Password"
    End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
rmc71291Author Commented:
Thanks much for your help.  This does exactly what I was asking for.
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
0
rmc71291Author Commented:
Thanks Martin.  I think you may be the only person that can help me easily but I do have one more question.  I run ActiveSheet.Protect and ActiveSheet.Unprotect in many other modules and I run ActiveSheet.Protect on Close.  I notice that even though the sheet is protected the toggle button you helped me create always says protect on open.

Is there a line or 2 of code I could run in the other modules after I change the protection status to change the toggle button so it always follows the real status of protection?

I'd be happy to put this request in another question if that is a more appropriate way to ask this follow up question.
0
Martin LissOlder than dirtCommented:
This may take some work (and I don't mind) but one possible easy solution would be to not Protect the sheet on Close. Would that be acceptable?

BTW, I don't know why you protect and unprotect your sheets and so this may not be pertinent, but are you aware that you can stop users from making changes but still be able to make changes via code if you do the following?

ActiveSheet.Protect UserInterfaceOnly:=True
0
rmc71291Author Commented:
Unfortunately not.  Most of the sheet entry is through a barcode scanner and I found if I don't protect it then people scan in barcodes where they shouldn't.   I tried to avoid this at first with cell validation but it still confused people.  Basically the sheet is protected at startup and each module unprotects, enters the data where it should then protects.  There is one module that keeps it unprotected so the user can enter item descriptions by hand then manually protect again using the toggle button.
0
Martin LissOlder than dirtCommented:
Basically the sheet is protected at startup and each module unprotects, enters the data where it should then protects.
I don't know if you saw it, but I edited my previous post and talked about ActiveSheet.Protect UserInterfaceOnly:=True. Did you see it?
0
rmc71291Author Commented:
Oh wow I did NOT see that.   Let me try that first.   Thanks!
0
rmc71291Author Commented:
Martin,

I tried that and it did not work.  I think its because my users required that I show them which line item is being changed so I am selecting the cell.  It won't run the following code because it says it protected (even though I say ActiveSheet.Protect UserInterfaceOnly:=True) when I close the workbook.

Private Sub TextBox1_Change()
    ' Only run this code when there is information in UserForm5.TextBox1
    If UserForm5.TextBox1.Text = vbNullString Then Exit Sub
        Worksheets("Main").Unprotect
        Dim TargetCell As Range
        If WorksheetFunction.CountIf(Sheets("Main").Columns(4), UserForm5.TextBox1.Value) = 1 Then
            Set TargetCell = Sheets("Main").Columns(4).Find(UserForm5.TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
            TargetCell.Select
            TargetCell.Value = TargetCell.Value + 1
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Hardware Insert.wav", 0&
            UserForm5.TextBox1.Value = ""
            UserForm5.TextBox1.SetFocus
        Else
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Critical Stop.wav", 0&
            MsgBox "Item Not Found", vbExclamation
        End If
        UserForm5.TextBox1.Text = vbNullString
        UserForm5.TextBox1.SetFocus
        
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
This works. The change is at line 5. I also have a question at line 20.

Private Sub TextBox1_Change()
    ' Only run this code when there is information in UserForm5.TextBox1
    If UserForm5.TextBox1.Text = vbNullString Then Exit Sub
        ' Change this
        'Worksheets("Main").Unprotect
        Worksheets("Main").Protect UserInterfaceOnly:=True
        
        Dim TargetCell As Range
        If WorksheetFunction.CountIf(Sheets("Main").Columns(4), UserForm5.TextBox1.Value) = 1 Then
            Set TargetCell = Sheets("Main").Columns(4).Find(UserForm5.TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
            TargetCell.Select
            TargetCell.Value = TargetCell.Value + 1
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Hardware Insert.wav", 0&
            UserForm5.TextBox1.Value = ""
            UserForm5.TextBox1.SetFocus
        Else
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Critical Stop.wav", 0&
            MsgBox "Item Not Found", vbExclamation
        End If
        ' Why do you do this? Doing so doesn't allow the user to see what he
        ' typed in if the value is found
        UserForm5.TextBox1.Text = vbNullString
        
        
        UserForm5.TextBox1.SetFocus
        
End Sub

Open in new window

0
rmc71291Author Commented:
OK, I think this is working.  I'll play with it some more.

As for line 20 I'll try to give you a picture of what I'm doing.  This is an inventory system that runs with a scanner.  The inputs are not hand-typed.  In this partcular set, I call it FreeScan.  This coupled with the set of code below allows the user to just unpack items that are already in the system and just scan them at will.  Each time he scans something the text box needs to clear for the next item to be scanned.  The code below waits 2 seconds just to ensure the scanner has time to input the value.  I think I'll need to tune the timing a little and maybe drop it to 1 second for faster scanning of multiple items.  Does that make sense?   When I started I didn't even know how to code a msgbox display or even what a sub was.  I still don't know much but I'm having fun learning.

Private Sub UserForm_Initialize()

  IsActive = False
  TextBox1.SetFocus
  
End Sub

Private Sub TextBox1_Change()

If Not IsActive And TextBox1.Text <> "" Then
  
  IsActive = True
  Application.OnTime Now + TimeValue("00:00:02"), "Module9.TextBox1_Change"

End If

End Sub

Open in new window

0
rmc71291Author Commented:
Martin,

I think I am very close to being done.  I changed your protection code below as it shows because I always protect on close so it made no sense for the button to say "Protect" when the sheet is already protected.

Option Explicit

Public gbProtected As Boolean
Public gxRibbonUI As IRibbonUI

Sub GetDownloadLabel(control As IRibbonControl, ByRef returnedVal)
     
    If gbProtected Then
        'returnedVal = "UnProtect"
        returnedVal = "Protect"
    Else
        'returnedVal = "Protect"
        returnedVal = "UnProtect"
    End If
     
End Sub

Private Sub RibbonUI_onLoad(ribbon As IRibbonUI)

    Set gxRibbonUI = ribbon
    Application.SendKeys "%Y%"
    
End Sub

Sub ProtectSheetToggle(control As IRibbonControl, pressed As Boolean)
     
    gbProtected = pressed
        
gxRibbonUI.InvalidateControl "customButton1"
    
    If pressed Then
    
        'ActiveSheet.Protect
        ActiveSheet.Unprotect
    Else
        'ActiveSheet.Unprotect
        ActiveSheet.Protect
    End If
    
End Sub

Open in new window


Now, all I need is to add something to the code below that will change the button to say "Protect" and actually mean it, after this code runs.  This set of code allows the user to add new barcodes for new items then leaves the sheet unprotected so they can hand-type in the description of the item.  I can't autoprotect because there is no telling how long it will take the user to handtype the information.  I guess I could use a form instead for the user to fill out if you think my suggestion will take too much time for you.

Dim IsActive As Boolean

Sub AddNewItem()
Worksheets("Main").Activate
If UserForm2.TextBox1.Text = "" Then Exit Sub

    With Worksheets("Main")
        If Application.CountIf(.Range("D:D"), UserForm2.TextBox1.Text) = 0 Then
        Worksheets("Main").Unprotect
        .Range("D" & .Rows.Count).End(xlUp)(2).Value = UserForm2.TextBox1.Text
        .Range("D" & .Rows.Count).End(xlUp).Offset(, -3).Select
        MsgBox "Item Added" & vbCrLf & "Add details of item starting with description." & vbCrLf & "WARNING - Protect sheet when done.", vbExclamation, "Item Added"
        Else
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Critical Stop.wav", 0&
            MsgBox "That Item Already Exists", vbExclamation
        End If
    End With

UserForm2.TextBox1.Text = ""
UserForm2.TextBox1.SetFocus
IsActive = False
Unload UserForm2

End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
I think I have the solution.

Add line 5

Option Explicit

Public gbProtected As Boolean
Public gxRibbonUI As IRibbonUI
Public gbManual As Boolean

Open in new window


and add lines 21 to 24.
Sub AddNewItem()
Worksheets("Main").Activate
If UserForm2.TextBox1.Text = "" Then Exit Sub

    With Worksheets("Main")
        If Application.CountIf(.Range("D:D"), UserForm2.TextBox1.Text) = 0 Then
        Worksheets("Main").Unprotect
        .Range("D" & .Rows.Count).End(xlUp)(2).Value = UserForm2.TextBox1.Text
        .Range("D" & .Rows.Count).End(xlUp).Offset(, -3).Select
        MsgBox "Item Added" & vbCrLf & "Add details of item starting with description." & vbCrLf & "WARNING - Protect sheet when done.", vbExclamation, "Item Added"
        Else
            sndPlaySound32 "C:\Windows\Media\Quirky\Windows Critical Stop.wav", 0&
            MsgBox "That Item Already Exists", vbExclamation
        End If
    End With

UserForm2.TextBox1.Text = ""
UserForm2.TextBox1.SetFocus
IsActive = False
Unload UserForm2
gbProtected = False
gxRibbonUI.InvalidateControl "customButton1"
ActiveSheet.Protect
gbManual = True

End Sub

Open in new window

0
rmc71291Author Commented:
That does it!  Thanks so much Martin.
0
Martin LissOlder than dirtCommented:
We aim to please.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.