Disallowing Workbook Access with a Splashscreen

One way to do it:
Assign a value to a variable upon pushing the button denoting acceptance and use a test  that is triggered as the workbook loads that exits if the variable's value is not equal to the value assigned to denote acceptance.

Amick,

Thanks for the quick response.  Can you actually show me the code you would use to assign a variable?  I'm assuming that I'd put it in the worksheet? (or a module?) and than what is the formula for testing the condition? ( an If Statement?)?

Thanks,

B.

Get rid of the top bar and X of your splash screen, so Accept or Cancel is the ONLY thing they can do.

Do you know how to do this?

Dave

Dim TermsAccepted
Private Sub Workbook_Open()
 TermsAccepted = Interaction.MsgBox("Do you accept these terms?", vbYesNo + vbSystemModal, "User Agreement")
End Sub

This is worth a read...
You can either remove the bar and X at the top of your splash screen userform, or you can do this:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "To exit this form, please click Accept button," & vbCrLf & _
"or the ''Cancel'' button.", 16, "The ''X'' close button is disabled."
Cancel = True
End If
End Sub


Finally, Andy Pope has some great tips on Splash Screens, here:

http://www.xcelfiles.com/SplashScrn.html

Cheers,

Dave

Amick: I have created so many splash screens for my project and I use the same concept as what Dave suggested above. I remove the Top Blue bar using API's so it actually looks like a splash screen.

Let me search for an example for you from my database.

Sid

Ok Here is an example Attached.

If you click on "Accept" it will let you enter else it will exit the workbook.

Sid

Code Used In Workbook open event

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Select allOpen in new window

Code Used in Userform

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal Hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000

Dim Hwnd As Long

Private Sub UserForm_Initialize()
    Hwnd = FindWindow("ThunderXframe", UserForm2.Caption)

    IStyle = GetWindowLong(Hwnd, GWL_STYLE)
    IStyle = IStyle And Not WS_CAPTION
    X = SetWindowLong(Hwnd, GWL_STYLE, IStyle)
    DrawMenuBar Hwnd
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    ActiveWorkbook.Close savechanges:=False
End Sub

Select allOpen in new window

Splash-Screen.xls

Sorry Change line 13 to

Hwnd = FindWindow("ThunderXframe", UserForm1.Caption)

Sid

Here I have made the changes.

Sid

Code Now Used

In Workbook Open Event

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Select allOpen in new window

In UserForm Code Area

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000

Dim hHwnd As Long

Private Sub UserForm_Initialize()
    hHwnd = FindWindow("ThunderDframe", UserForm1.Caption)

    IStyle = GetWindowLong(hHwnd, GWL_STYLE)
    IStyle = IStyle And Not WS_CAPTION
    X = SetWindowLong(hHwnd, GWL_STYLE, IStyle)
    DrawMenuBar hHwnd
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    ActiveWorkbook.Close savechanges:=False
End Sub

Select allOpen in new window

Splash-Screen.xls

Sid, Dave, Amick,

Lots of great input.  I'm getting the following error on the code that was sent (Sid's code).

Please take a look.

B.
Errors.ppt

Bright01: You the file that I gave in ID: 35172200

Sid
      

Sid,

I've attempted to incorporate your Splash Screen into mine with little to no luck.  All I want to do is to refuse access if they do not press "I Accept".  My code within the user form looks like this:

Option Explicit

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Activate()

   UserForm1.Label1.FontSize = 12
    Me.Label1.Caption = "This Excel Workbook is the Property of IBM and should only be used with Information Agenda Partners on IBM related client engagements."

End Sub

Private Sub cmdOK_Click()
   Unload Me
End Sub
Private Sub Label1_Click()

End Sub
Private Sub TextBox1_Change()

End Sub
Private Sub UserForm_Click()

End Sub

How do I disallow the workbook to open in the event that they do not hit the "I approve" button?  I do not have a "do not accept" option.

Thank you,

B.

If you can upload your workbook then I can make those changes for you :)

Sid

The tip I put out there on 35172060 is a simpler solution that fits the bill.  Did you test it?

Dave

Dave,

Thanks for pointing me in the direction.  One problem; I installed the code and ran it.  However, now as I click on "I Accept" it won't do anything and the "X" buttons are don't work.  Is there a way to cancel the splash screen so I can get back to the code?  I think I may need to change the coding as to what the button does.

Please advise,

B.

Sorry for the last post:

Dave,

Thanks for pointing me in the direction.  One problem; I installed the code and ran it.  However, now as I click on "I Accept" it won't do anything and the "X" buttons now don't work either.  Is there a way to cancel the splash screen so I can get back to the code?  I think I may need to change the coding as to what the button does.

Please advise,

B.

:) sorry about that.

pull up Excel,  then click the Office Button at the top left hand corner of Excel, and see your file in "recent documents'.

Hold the SHIFT key down when you select the file - this will keep the Workbook_Open macro from running, then you can fix.

Dave

Another alternative is to pull up Excel, get the VBA Project debugger open, then open your file, you can toggle to the debugger and make changes unless you've locked the project.

Dave

You'll want to ensure the ACCEPT button works properly, before testing this piece of code (afterthought on my part too)

:)

B - you can use this little app and it will open your workbook with events disabled, then they're enabled after open.  That should get you past the splashscreen...

Dave
Open-Selected-Workbooks-noOpenEv.xlsm

And - of course by now you've realized there really is no protection - but you're not protecting, you're just trying to get some acknowledgement of their responsibilities and if they bypass after that that would be a bit negligent and probably (I'm not a lawyer) liable if they didn't follow the policy you're prompting them to accept.

Dave

Dave,

Cool!  However, I always make a temp copy when testing code.  But thanks for showing me  how to keep the splash screen from opening.  So now that I have it up, I'm not sure how to make the button work........ do I make the change in the Properties section?

B.

Please send me what you have, it would make it faster.

Can you do this?

Dave

Ok - this will get you going, I think.

Here's the code I put in the userform:

Private Sub CommandButton1_Click()
    MsgBox " thank you"
    Unload UserForm1
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "To exit this form, please click Accept button," & vbCrLf & _
"or the ''Cancel'' button.", 16, "The ''X'' close button is disabled."
Cancel = True
End If
End Sub

You could also write code behind the Refuse button for the excel application to close itself out.

see attached

Dave

SampleSplash.xlsm

Dave,

Here is the code I have right now. All I need is the ability to stop a user from progressing if they don't press the button.


Option Explicit

Private Sub Label2_Click()
End Sub
Private Sub cmdOK_Click()
End Sub
Private Sub UserForm_Activate()
    UserForm1.Label1.FontSize = 12
    Me.Label1.Caption = "This Excel Workbook is the Property of XXX and should only be used with related client engagements."

End Sub

Private Sub cmdOK_Click()
   Unload Me
End Sub
Private Sub Label1_Click()

End Sub
Private Sub TextBox1_Change()

End Sub
Private Sub UserForm_Click()

End Sub

Try to compile your code and it should flag that error - re: two subroutines with the same name.

Bright: If you would have given me a sample file, I would have amended it till now :)

Sid

Sid,

I cannot recreate my splash screen.  I get all kinds of errors.  It's a very complex workbook. I can only give you the code I have.

Dave,

I looked at your code; and I embedded it.  I can't get it to work. Let me give this one more try.

I have a Sheet (Sheet 11) that is my splash screen.
I have a Form.... UserForm1
The UserForm has a Box with Text that describes the basic Ts&Cs. Within the Box is another box that looks like a button that says "I Accept".
The code behind the "I Accept" Button is:

Option Explicit

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Activate()

   UserForm1.Label1.FontSize = 12
    Me.Label1.Caption = "This Excel Workbook is the Property of XXX and should only be used with XXX Partners on XXX related client engagements."

End Sub

Private Sub cmdOK_Click()
   Unload Me
End Sub
Private Sub Label1_Click()

End Sub
Private Sub TextBox1_Change()

End Sub
Private Sub UserForm_Click()

End Sub

In Module1 I have the following code:

'This Macro produces the initial splash screen
Sub ShowForm()
    UserForm1.Show
End Sub

What I need is a line or two in the right place that restricts access unless you push the button.

B.

Wow... I don't think I've ever spent so much time on one function!  However, for you guys, this was far more effort than anticipated I'm sure.  I tried both solutions and finally, on Sid's last set of comments, was able to figure out enough to embed part of his code into what I already was working with in order to get it to lock without progressing.  Much thanks to both of you.  

B.