Solved

Disallowing Workbook Access with a Splashscreen

Posted on 2011-03-19
31
253 Views
Last Modified: 2012-05-11
I have a workbook where when it gets launched, a splach screen provides the user with specific terms of use. On the splash screen, I have a button that acknowledges that the user has read the terms.  When clicked, they should have access to the workbook.  The problem is, that if you simply close the splash screen, it allows you to bypass the acceptance.  I was told to set ShowModal to "True" on the Properties tab but this doesn't seem to work. Can you give me any advise on how to make the workbook inaccessable if you don't push the "I Accept" button?

Thank you,

B.
0
Comment
Question by:Bright01
  • 12
  • 9
  • 8
  • +1
31 Comments
 
LVL 12

Expert Comment

by:Amick
ID: 35171648
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.
0
 

Author Comment

by:Bright01
ID: 35171735
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35171791
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
0
 
LVL 12

Expert Comment

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

0
 
LVL 41

Expert Comment

by:dlmille
ID: 35172060
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
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172130
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
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172165
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

Open 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

Open in new window

Splash-Screen.xls
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172169
Sorry Change line 13 to

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

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172200
Here I have made the changes.

Sid

Code Now Used

In Workbook Open Event

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Open 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

Open in new window

Splash-Screen.xls
0
 

Author Comment

by:Bright01
ID: 35172233
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
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172240
Bright01: You the file that I gave in ID: 35172200

Sid
      
0
 

Author Comment

by:Bright01
ID: 35172566
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.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35172602
If you can upload your workbook then I can make those changes for you :)

Sid
0
 
LVL 41

Expert Comment

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

Dave
0
 

Author Comment

by:Bright01
ID: 35173140
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.
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:Bright01
ID: 35173144

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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173265
:) 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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173268
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
0
 
LVL 41

Expert Comment

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

:)
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173323
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
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173327
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
0
 

Author Comment

by:Bright01
ID: 35173535
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173652
Please send me what you have, it would make it faster.

Can you do this?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35173669
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
0
 

Author Comment

by:Bright01
ID: 35173940
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
0
 
LVL 41

Assisted Solution

by:dlmille
dlmille earned 100 total points
ID: 35174129
ok - did you look at the code I sent you?  You need to add the userform_queryclose() routine I gave you that keeps him/her from not accepting.  And you have the OK click to unload.

What else is missing athat I don't see?  Except you have TWO cmdOK_Click() routines.  Delete the one that has no code in it.

That should do it?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 35174131
Try to compile your code and it should flag that error - re: two subroutines with the same name.
0
 
LVL 30

Expert Comment

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

Sid
0
 

Author Comment

by:Bright01
ID: 35175253
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.
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 150 total points
ID: 35175295
B

It is very simple. All you need to do is copy the code that I gave above from Line 1 to 24 and paste it in your userform.

In the click button "Accept", type this code

Unload Me

as shown in line 26 to 28

and in the click button "Disagree", type this code

ActiveWorkbook.Close savechanges:=False

as shown in line 30 to 33.

Hope this helps.

Sid
0
 

Author Closing Comment

by:Bright01
ID: 35175711
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.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now