PDA

View Full Version : [SOLVED] Merging two Private Sub



Allen
01-02-2018, 09:32 AM
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
01-02-2018, 09:48 AM
Moved from thread about a different issue: Compare dates - password required if expired (http://www.vbaexpress.com/forum/showthread.php?61620-Compare-dates-password-required-if-expired)

Paul_Hossler
01-03-2018, 08:29 AM
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
01-03-2018, 09:28 AM
I've tried rearrange the coding but and getting problems with CheckShiftOnOpen()
I Know both files works alone individually but merging the two files :banghead::banghead::banghead: .



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
01-03-2018, 01:28 PM
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
01-03-2018, 03:11 PM
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/ (http://pixcels.nl/disable-shift-key-on-open/) link

Allen
01-04-2018, 07:12 AM
Thanks Paul