sparky2205
Well-known Member
- Joined
- Feb 6, 2013
- Messages
- 507
- Office Version
- 365
- 2016
- Platform
- Windows
Hi folks,
I have a spreadsheet with a number of macros.
Everything runs fine on my laptop but when I send the file to someone else I get the #BLOCKED! error.
I unblocked the file before sending it but I still have the issue.
This is what it looks like on other sets:
This is what it looks like on my set:
The offending macro is "Update Worksheet Names"
This is the code behind the macro:
I emailed the file to my colleague who had the issue.
I also had him open the file at a shared location which also resulted in the same issue for him.
There is no option to Unblock the file now.
The older macros, these were existing ones on the file; Copy, Rename, Delete a Worksheet all work fine on both sets. Prepare for Printing, which is a new macro, also works fine. I cannot check Hide or Unhide ALL Worksheets as these depend on the Worksheet Name list being populated.
Any assistance would be greatly appreciated folks.
I have a spreadsheet with a number of macros.
Everything runs fine on my laptop but when I send the file to someone else I get the #BLOCKED! error.
I unblocked the file before sending it but I still have the issue.
This is what it looks like on other sets:
This is what it looks like on my set:
The offending macro is "Update Worksheet Names"
This is the code behind the macro:
VBA Code:
Sub GetWorkSheetName()
Dim swsname As String
Dim iSheetCount As Integer
Dim c As Range
Dim cb As CheckBox
Dim a As Integer: a = 3
Dim lr As Integer
Dim pw As String: pw = "Accipiter$17"
Worksheets("Setup").Unprotect Password:=pw
On Error GoTo errhandler
Application.ScreenUpdating = False
iSheetCount = ThisWorkbook.Sheets.Count
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A2:A" & lr).Clear
ActiveSheet.CheckBoxes.Delete
ActiveSheet.Range("A1").Clear
With ActiveSheet.Range("B1:B100")
.Clear
.Locked = True
End With
ActiveSheet.Range("B3:B" & lr).Locked = False
ActiveSheet.Range("A2").Formula2R1C1 = "=TRANSPOSE(INDEX(SheetNames,R[-1]C))"
For Each c In Range("C3:C" & iSheetCount)
Set cb = ActiveSheet.CheckBoxes.Add(c.Left + 25, _
c.Top, _
c.Width, _
c.Height)
With cb
.Caption = ""
.Value = xlOff
.LinkedCell = "B" & a
.Display3DShading = False
End With
a = a + 1
Next
'Application.DisplayAlerts = False
ActiveSheet.Range("A2#").Copy
ActiveSheet.Range("A2:A" & iSheetCount + 1).PasteSpecial xlPasteValues
'Application.DisplayAlerts = True
ActiveSheet.Range("A" & iSheetCount + 1).Clear
ActiveSheet.Range("A2").Clear
With ActiveSheet.Range("A1")
.Value = "Worksheet Name"
.Font.Bold = True
End With
lr = 0
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
With ActiveSheet.Range("A" & lr + 1)
.Value = "Denotes hidden sheet"
.Interior.ColorIndex = 6
.BorderAround ColorIndex:=1
End With
Application.CutCopyMode = False
Application.CutCopyMode = True
Application.Range("A1").Select
Application.ScreenUpdating = True
Worksheets("Setup").Protect Password:=pw
Exit Sub
errhandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ThisWorkbook.Protect pw
Worksheets("Setup").Protect Password:=pw
End Sub
I emailed the file to my colleague who had the issue.
I also had him open the file at a shared location which also resulted in the same issue for him.
There is no option to Unblock the file now.
The older macros, these were existing ones on the file; Copy, Rename, Delete a Worksheet all work fine on both sets. Prepare for Printing, which is a new macro, also works fine. I cannot check Hide or Unhide ALL Worksheets as these depend on the Worksheet Name list being populated.
Any assistance would be greatly appreciated folks.