Quantcast
Channel: VBForums - Visual Basic .NET
Viewing all articles
Browse latest Browse all 27333

[RESOLVED] Forcing users to enable macros

$
0
0
Hello,
I found this nifty method to force users to enable macros and so far it's working great and was very easy to implement.
See method here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=379

The problem now is that I need to modify the code so that instead of all the sheets un-hiding only four of the sheets to unhide and since this code was a piece of cake to implement and I am a noob when it comes to this stuff I have no idea where to start.
Those four sheets are titled:

String Sizing
Voltage Drop
Performance
Custom Equipment

The code which is located in the ThisWorkBook object:

Code:

Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Turn off events to prevent unwanted loops
    Application.EnableEvents = False
   
    'Evaluate if workbook is saved and emulate default propmts
    With ThisWorkbook
        If Not .Saved Then
            Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
                vbYesNoCancel + vbExclamation)
                Case Is = vbYes
                    'Call customized save routine
                    Call CustomSave
                Case Is = vbNo
                    'Do not save
                Case Is = vbCancel
                    'Set up procedure to cancel close
                    Cancel = True
            End Select
        End If
   
    'If Cancel was clicked, turn events back on and cancel close,
    'otherwise close the workbook without saving further changes
        If Not Cancel = True Then
            .Saved = True
            Application.EnableEvents = True
            .Close savechanges:=False
        Else
            Application.EnableEvents = True
        End If
    End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Turn off events to prevent unwanted loops
    Application.EnableEvents = False
   
    'Call customized save routine and set workbook's saved property to true
    '(To cancel regular saving)
    Call CustomSave(SaveAsUI)
    Cancel = True
   
    'Turn events back on an set saved property to true
    Application.EnableEvents = True
    ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
    'Unhide all worksheets
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
    Dim ws As Worksheet, aWs As Worksheet, newFname As String
    'Turn off screen flashing
    Application.ScreenUpdating = False
   
    'Record active worksheet
    Set aWs = ActiveSheet
   
    'Hide all sheets
    Call HideAllSheets
   
    'Save workbook directly or prompt for saveas filename
    If SaveAs = True Then
        newFname = Application.GetSaveAsFilename( _
            fileFilter:="Excel Files (*.xls), *.xls")
        If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
    Else
        ThisWorkbook.Save
    End If
   
    'Restore file to where user was
    Call ShowAllSheets
    aWs.Activate
   
    'Restore screen updates
    Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
    'Hide all worksheets except the macro welcome page
    Dim ws As Worksheet
   
    Worksheets(WelcomePage).Visible = xlSheetVisible
   
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws
   
    Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
    'Show all worksheets except the macro welcome page
   
    Dim ws As Worksheet
   
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws
   
    Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

Any help greatly appreciated! Cheers. :)

John

Viewing all articles
Browse latest Browse all 27333

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>