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
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.