Custom Toolbar Add-in

M

Matt Agnes

I have a custom toolbar with buttons to protect and unprotect workbooks. I
have tried adding two new buttons, which run Macros to protect/unprotect all
of the sheets in a workbook. The macro works fine when run manually, but if
it is run from the custom toolbar it comes up with an error message in Visual
Basic saying: 'Compile Error - Variable not defined', The error message
refers to the line 'For Each sh In ActiveWorkbook.Worksheets' within 'Sub
ProtectAll2()'.

Has anyone got any idea what I should do to fix this?

Cheers,
Matt

The full code for the add-in is as follows:

Option Explicit

Public Const ToolBarName As String = "ShortHaulOffersTemplate"

Sub Auto_Open()
Call CreateMenubar
End Sub

Sub Auto_Close()
Call RemoveMenubar
End Sub


Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub


Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNamess As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("Protect", _
"Unprotect", _
"ProtectNew", _
"UnprotectNew", _
"ProtectAll2", _
"UnprotectAll2")


CapNamess = Array("Protect", _
"Unprotect", _
"ProtectNew", _
"UnprotectNew", _
"ProtectAll2", _
"UnprotectAll2")

TipText = Array("Protect Workbook Old", _
"Unprotect Workbook Old", _
"Protect Workbook New", _
"Unprotect Workbook New", _
"Protect All", _
"Unprotect All")


With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarTop

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNamess(iCtr)
.Style = msoButtonIconAndCaption
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With
End Sub


Sub Protect()

ActiveSheet.Protect Password:="TELETEXT", DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:="TELETEXT", Structure:=True,
Windows:=False

End Sub

Sub Unprotect()

ActiveWorkbook.Unprotect Password:="TELETEXT"
ActiveSheet.Unprotect Password:="TELETEXT"

End Sub


Sub ProtectNew()

ActiveSheet.Protect Password:="Password", DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:="Password", Structure:=True,
Windows:=False

End Sub

Sub UnprotectNew()

ActiveWorkbook.Unprotect Password:="Password"
ActiveSheet.Unprotect Password:="Password"

End Sub
Sub ProtectAll2()

Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = True Then
sh.Select
ActiveSheet.Protect Password:="Password",
DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next sh

ChDir "C:\Documents and Settings\MatthewA\Desktop"

Application.ScreenUpdating = True


Application.ScreenUpdating = True

End Sub


Sub UnprotectAll2()

Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = True Then
sh.Select
ActiveSheet.Unprotect Password:="Password"
End If
Next sh

ChDir "C:\Documents and Settings\MatthewA\Desktop"

Application.ScreenUpdating = True

End Sub
 
P

paul.robinson

Hi
Try this. Screenupdating kicks in automatically when a sub finishes,
so you can leave it out. Also the pair
sh.select
activesheet.protect

can be shortened to
sh.protect

In general, you need not select anything to work on it.

Sub ProtectAll2()
Dim sh as worksheet

Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = True Then
sh.Protect Password:="Password",
DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next sh


ChDir "C:\Documents and Settings\MatthewA\Desktop"
End Sub


regards
Paul
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top