Merging two Private Sub

[Allen]

Hi Guys,

I've tried to lookup merging two private sub to create 1 file but keep failing.
The first one was one was coding by Dave, the second one is to prevent people holding the shift key to open.

Obviously I want to merge to two files into one.

Your help would be most appreciated

Allen

[SamT]

Moved from thread about a different issue: Compare dates - password required if expired

[Paul_Hossler]

I'd expect that CheckShiftOnOpen and the others would not run if the user disables macros by holding down Shift when opening the workbook


This might give you some ideas for a technique for forcing the user to enable macros

http://www.vbaexpress.com/kb/getarticle.php?kb_id=379

[Allen]

I've tried rearrange the coding but and getting problems with CheckShiftOnOpen()
I Know both files works alone individually but merging the two files .



Option Explicit
Private mbMacrosEnabled As Boolean


Private Sub Worksheet_Open()
Call Macro1
Call Macro2
End Sub


Private Sub Macro1()
mbMacrosEnabled = True
End Sub


Public Function CheckShiftOnOpen()
If Not mbMacrosEnabled Then
MsgBox "Don't press Shift on opening the workbook!", vbCritical, "Fatal error"
Application.Quit
End If
End Sub


Private Sub Macro2()
Dim d1 As Date
Dim d2 As Date, Cnt As Integer
Dim password As String
d1 = DateSerial(2018, 12, 31)
d2 = Date
If d2 > d1 Then
above:
password = InputBox("enter password")
If password = "abc123" Then
MsgBox ("Welcome!")
Else
MsgBox ("Incorrect password!")
Cnt = Cnt + 1
'3 trials of password input
If Cnt < 3 Then
GoTo above
Else
MsgBox "ACCESS DENIED"
Application.Quit
End If
End If
Else
MsgBox ("Opening file")
End If
End Sub

[SamT]

First read this: http://pixcels.nl/disable-shift-key-on-open/
After you get CheckShiftOnOpen working then

Public Function CheckShiftOnOpen()
    If Not mbMacrosEnabled Then
        MsgBox "Don't press Shift on opening the workbook!", vbCritical, "Fatal error"
        Application.Quit
Else
Dim d1 As Date
    Dim d2 As Date, Cnt As Integer
    Dim password As String
    d1 = DateSerial(2018, 12, 31)
    d2 = Date
    If d2 > d1 Then
above:
        password = Inpu......'The rest
    End If
End Sub

Or:

Public Function CheckShiftOnOpen()
    If Not mbMacrosEnabled Then
        MsgBox "Don't press Shift on opening the workbook!", vbCritical, "Fatal error"
        Application.Quit
Else
Macro2
    End If
End Sub

Or Just leave the code as is. There is no need or advantage to complicate things by actually merging the two Procedures

[Paul_Hossler]

My thoughts

What I don't understand is the intention with this ...

d1 = DateSerial(2018, 12, 31)
    d2 = Date
    If d2 > d1 Then

since 1/3/2018 (d2) is before 12/31/2018 (d1) then d2 is NOT > d1 then check pw logic is skipped. Is that what you want?

I changed it to 12/31/2016 to test



1. In ThisWorkbook

Option Explicit

'http://pixcels.nl/disable-shift-key-on-open/

'fires first
Private Sub Workbook_Open()
    mbMacrosEnabled = True
End Sub

2. In Standard Module

Option Explicit
Public mbMacrosEnabled As Boolean
'this fires after WB_Open
Sub customUIonLoad(ribbon As IRibbonUI)
    Application.EnableCancelKey = xlDisabled
    
    CheckShiftOnOpen
    Application.EnableCancelKey = xlInterrupt
End Sub
Public Function CheckShiftOnOpen()
    
    If Not mbMacrosEnabled Then
        MsgBox "Don't press Shift on opening the workbook!", vbCritical, "Fatal error"
        'Application.Quit   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        MsgBox "Application will .Quit here"
    Else
    
        Dim d1 As Date
        Dim d2 As Date, Cnt As Integer
        Dim password As String
        d1 = DateSerial(2016, 12, 31)   '<<<<<<<<<<<<<<<<<<<<<<<<<<<<< WHY 12/31/2018??? I changed it for test
        d2 = Date
        
        If d2 > d1 Then                 '<<<<< 1/3/2018 is NOT > 12/31/2018 so the 'PW question never runs
above:
            password = InputBox("enter password")
            If password = "abc123" Then
                MsgBox ("Welcome!")
            Else
                MsgBox ("Incorrect password!")
                Cnt = Cnt + 1
                 '3 trials of password input
                If Cnt < 3 Then
                    GoTo above
                Else
                    MsgBox "ACCESS DENIED"
                    'Application.Quit   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                    MsgBox "Application will .Quit here"
                End If
            End If
        Else
            MsgBox ("Opening file")
        End If
        
        
        End If
End Function

PS -- thanks to SamT for that http://pixcels.nl/disable-shift-key-on-open/ link

[Allen]

Thanks Paul