Macros not working when sent to someone using Excel 2010 but working with other people using Excel 2016

chafr

New Member
Joined
May 11, 2017
Messages
3
Hi,

I have been working for quite some time on a code that would protect a worksheet from printing/copying/pasting/saving and force people to enable macros. It works perfectly fine with my computer running Excel 2016 and works with my colleagues who also have Excel 2016 however when I sent that to our client who's running Excel 2010, nothing works. There are no error messages but the macros just don't do what they are supposed to do. Any hel

Here is the code:

Code:
Option Explicit[/I][I]Const WelcomePage = "Macros"[/I]

[I]Private Sub Workbook_BeforeClose(Cancel As Boolean)[/I]
[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]Call ToggleCutCopyAndPaste(True)[/I]
[I]End If[/I]

[I]    'Turn off events to prevent unwanted loops[/I]
[I]Application.EnableEvents = False[/I]

[I]     'Evaluate if workbook is saved and emulate default propmts[/I]
[I]    With ThisWorkbook[/I]
[I]       If Not .Saved Then[/I]
[I]            ActiveWorkbook.Close savechanges:=False[/I]
[I]            Application.EnableEvents = True[/I]
[I]            End If[/I]
[I]    End With[/I]

[I]Dim sht As Worksheet, csheet As Worksheet[/I]
[I]Application.ScreenUpdating = False[/I]
[I]Set csheet = ActiveSheet[/I]
[I]For Each sht In ActiveWorkbook.Worksheets[/I]
[I]  If sht.Visible Then[/I]
[I]    sht.Activate[/I]
[I]    Range("A1").Select[/I]
[I]    ActiveWindow.ScrollRow = 1[/I]
[I]    ActiveWindow.ScrollColumn = 1[/I]
[I]  End If[/I]
[I]Next sht[/I]
[I]csheet.Activate[/I]
[I]Application.ScreenUpdating = True[/I]

[I]End Sub[/I]

[I]Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)[/I]
[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]MsgBox "File was opened as read-only and cannot be saved"[/I]
[I]Cancel = True[/I]
[I]ActiveWorkbook.Close savechanges:=False[/I]
[I]End If[/I]

[I]'Turn off events to prevent unwanted loops[/I]
[I]Application.EnableEvents = False[/I]

[I]'Call customized save routine and set workbook's saved property to true(To cancel regular saving)[/I]
[I]Call CustomSave(SaveAsUI)[/I]
[I]Cancel = True[/I]

[I]     'Turn events back on an set saved property to true[/I]
[I]Application.EnableEvents = True[/I]
[I]ThisWorkbook.Saved = True[/I]
[I]End Sub[/I]

[I]Private Sub Workbook_Open()[/I]

[I]     'Unhide all worksheets[/I]
[I]    Application.ScreenUpdating = False[/I]
[I]    Call ShowAllSheets[/I]
[I]    Application.ScreenUpdating = True[/I]
[I]Application.Goto ThisWorkbook.Sheets("Database menu").Range("A1"), True[/I]
[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"[/I]
[I]ActiveWindow.DisplayWorkbookTabs = False[/I]
[I]Call ToggleCutCopyAndPaste(False)[/I]
[I]End If[/I]
[I]End Sub[/I]


[I]Private Sub CustomSave(Optional SaveAs As Boolean)[/I]
[I]    Dim ws As Worksheet, aWs As Worksheet, newFname As String[/I]
[I]     'Turn off screen flashing[/I]
[I]    Application.ScreenUpdating = False[/I]

[I]     'Record active worksheet[/I]
[I]    Set aWs = ActiveSheet[/I]

[I]     'Hide all sheets[/I]
[I]    Call HideAllSheets[/I]

[I]     'Save workbook directly or prompt for saveas filename[/I]
[I]    If SaveAs = True Then[/I]
[I]       newFname = Application.GetSaveAsFilename( _[/I]
[I]        fileFilter:="Excel Files (*.xls), *.xls")[/I]
[I]        If Not newFname = "False" Then ThisWorkbook.SaveAs newFname[/I]
[I]   Else[/I]
[I]        ThisWorkbook.Save[/I]
[I]   End If[/I]

[I]     'Restore file to where user was[/I]
[I]    Call ShowAllSheets[/I]
[I]    aWs.Activate[/I]

[I]     'Restore screen updates[/I]
[I]    Application.ScreenUpdating = True[/I]
[I]End Sub[/I]


[I]Private Sub HideAllSheets()[/I]

[I]     'Hide all worksheets except the macro welcome page[/I]
[I]Dim ws As Worksheet[/I]
[I]Worksheets(WelcomePage).Visible = xlSheetVisible[/I]

[I]For Each ws In ThisWorkbook.Worksheets[/I]
[I]If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden[/I]
[I]Next ws[/I]

[I]Worksheets(WelcomePage).Activate[/I]
[I]End Sub[/I]

[I]Private Sub ShowAllSheets()[/I]
[I]     'Show all worksheets except the macro welcome page[/I]

[I]    Dim ws As Worksheet[/I]

[I]    For Each ws In ThisWorkbook.Worksheets[/I]
[I]        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible[/I]
[I]    Next ws[/I]

[I]    Worksheets(WelcomePage).Visible = xlSheetVeryHidden[/I]
[I]End Sub[/I]

[I]Private Sub Workbook_BeforePrint(Cancel As Boolean)[/I]

[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]Cancel = True[/I]
[I]MsgBox "Sorry, you cannot print this file", vbInformation[/I]
[I]End If[/I]
[I]End Sub[/I]

[I]Private Sub Workbook_Activate()[/I]

[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"[/I]
[I]ActiveWindow.DisplayWorkbookTabs = False[/I]
[I]Call ToggleCutCopyAndPaste(False)[/I]
[I]End If[/I]
[I]End Sub[/I]

[I]Private Sub Workbook_Deactivate()[/I]
[I]If ActiveWorkbook.ReadOnly Then[/I]
[I]Call ToggleCutCopyAndPaste(True)[/I]
[I]End If[/I]
[I]End Sub[/I]

with a module:

Code:
[I]Option Explicit[/I]

[I]Sub ToggleCutCopyAndPaste(Allow As Boolean)[/I]
[I]     'Activate/deactivate cut, copy, paste and pastespecial menu items[/I]
[I]    Call EnableMenuItem(21, Allow) ' cut[/I]
[I]    Call EnableMenuItem(19, Allow) ' copy[/I]
[I]    Call EnableMenuItem(22, Allow) ' paste[/I]
[I]    Call EnableMenuItem(755, Allow) ' pastespecial[/I]

[I]     'Activate/deactivate drag and drop ability[/I]
[I]    Application.CellDragAndDrop = Allow[/I]

[I]     'Activate/deactivate cut, copy, paste and pastespecial shortcut keys[/I]
[I]    With Application[/I]
[I]        Select Case Allow[/I]
[I]        Case Is = False[/I]
[I]            .OnKey "^c", "CutCopyPasteDisabled"[/I]
[I]            .OnKey "^v", "CutCopyPasteDisabled"[/I]
[I]            .OnKey "^x", "CutCopyPasteDisabled"[/I]
[I]            .OnKey "+{DEL}", "CutCopyPasteDisabled"[/I]
[I]            .OnKey "^{INSERT}", "CutCopyPasteDisabled"[/I]
[I]        Case Is = True[/I]
[I]            .OnKey "^c"[/I]
[I]            .OnKey "^v"[/I]
[I]            .OnKey "^x"[/I]
[I]            .OnKey "+{DEL}"[/I]
[I]            .OnKey "^{INSERT}"[/I]
[I]        End Select[/I]
[I]    End With[/I]
[I]End Sub[/I]

[I]Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)[/I]
[I]     'Activate/Deactivate specific menu item[/I]
[I]    Dim cBar As CommandBar[/I]
[I]    Dim cBarCtrl As CommandBarControl[/I]
[I]    For Each cBar In Application.CommandBars[/I]
[I]        If cBar.Name <> "Clipboard" Then[/I]
[I]            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)[/I]
[I]            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled[/I]
[I]        End If[/I]
[I]    Next[/I]
[I]End Sub[/I]

[I]Sub CutCopyPasteDisabled()[/I]
[I]     'Inform user that the functions have been disabled[/I]
[I]    MsgBox "Cutting, copying and pasting have been disabled in this file"[/I]
[I]End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
That usu means that persons Excel has macros turned off.
the must manually enable macros in setup.
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top