Splash Screen Questions

mhenk · Nov 21, 2007

Hey folks!

I'm adding a userform Splash screen to my project, listing some qualifications & limitations. I can get the form to show up, my 3 questions are:

1) is there a way to load a formatted text file into a control? I'd like to Have this model be totally independant of other files, so if there's a format-able lable or text box that I'm not seeing, that'd be the best bet.

2) how do I enable a button 10 seconds after the form loads?

3) how do I disable (or reprogram) the small "X" at the top corner? ideally, it'd be disabled.

Thanks!

Legacy 98055 · Nov 26, 2007

This example utilizes the webbrowser control to display your formatted text. As for the RichTextBox control and its availability too you? I don't know... I have so much crap installed on my system that I really don't know which app is came with. As for a developer's license for this control? I doubt that it is available with any installation of Office except for, maybe, the developer's edition. You will have to do your own research on this control.

Example Download: mhenk.302744.xls.zip

Download the example or... to set this up manually, add a worksheet named "Eula", add TextBox1 (ActiveX), and paste in your source HTML into TextBox1. Hide this worksheet.

Add a userform named "qual_limit" containing WebBrowser1, a commandbutton named "Accept", a commandbutton named "Decline".

Paste this code into your userform:
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Private pAccepted As Boolean

 Friend Property Get Accepted() As Boolean
 Accepted = pAccepted
 End Property

 Private Sub Accept_Click()
 'user clicks "Accept", lets them into the model
 pAccepted = True
 Me.Hide
 End Sub

 Private Sub Decline_Click()
 Me.Hide
 End Sub

 Public Sub UserForm_Activate()
 qual_limit.Caption = ActiveWorkbook.FullName
 End Sub

 Friend Sub EnableButton()
 Accept.Enabled = True
 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Disables the "X" button
 If CloseMode = vbFormControlMenu Then
 MsgBox "Please Accept or Decline the Qualifications & Limitations"
 Cancel = True
 End If
 End Sub
</td></tr></table><button onclick='document.all("1126200715823300").value=document.all("1126200715823300").value.replace(/ \s\s/g,"");document.all("1126200715823300").value=document.all("1126200715823300").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("1126200715823300").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1126200715823300" wrap="virtual">
Option Explicit

Private pAccepted As Boolean

Friend Property Get Accepted() As Boolean
Accepted = pAccepted
End Property

Private Sub Accept_Click()
'user clicks "Accept", lets them into the model
pAccepted = True
Me.Hide
End Sub

Private Sub Decline_Click()
Me.Hide
End Sub

Public Sub UserForm_Activate()
qual_limit.Caption = ActiveWorkbook.FullName
End Sub

Friend Sub EnableButton()
Accept.Enabled = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Disables the "X" button
If CloseMode = vbFormControlMenu Then
MsgBox "Please Accept or Decline the Qualifications & Limitations"
Cancel = True
End If
End Sub</textarea>

Paste this into your workbook class:
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Dim ql As qual_limit, AgreementAccepted As Boolean
 Private Const DelaySeconds As Integer = 5
 Private DelaySecondsCnt As Integer

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
 If AgreementAccepted Then
 'run code if Agreement accepted...

 Else
 'don't run code if Agreement declined...

 End If

 End Sub

 Private Sub Workbook_Open()
 SetUpEulaForm
 End Sub

 Private Sub SetUpEulaForm()
 Dim TempEulaPath As String

 TempEulaPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "tempEula.htm")

 Open TempEulaPath For Output As #1
 Print #1, Sheets("Eula").TextBox1.Text
 Close #1

 Set ql = New qual_limit
 ql.WebBrowser1.Navigate TempEulaPath
 Application.OnTime Now + TimeSerial(0, 0, 1), ThisWorkbook.CodeName & ".UpdateButton"
 ql.Show vbModal
 AgreementAccepted = ql.Accepted

 If AgreementAccepted Then
 MsgBox "Agreement accepted..."
 Else
 MsgBox "Agreement declined..."
 MsgBox "ThisWorkbook.Close False"
 End If

 On Error Resume Next
 Unload ql
 Set ql = Nothing
 Kill TempEulaPath
 End Sub

 Private Sub UpdateButton()
 On Error Resume Next
 DelaySecondsCnt = DelaySecondsCnt + 1
 If DelaySecondsCnt >= DelaySeconds Then
 ql.Accept.Caption = "Accept"
 ql.Accept.Enabled = True
 Else
 ql.Accept.Caption = "(" & Abs(DelaySecondsCnt - DelaySeconds) & ") Accept"
 Application.OnTime Now + TimeSerial(0, 0, 1), ThisWorkbook.CodeName & ".UpdateButton"
 End If
 End Sub

</td></tr></table><button onclick='document.all("11262007151257466").value=document.all("11262007151257466").value.replace(/ \s\s/g,"");document.all("11262007151257466").value=document.all("11262007151257466").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("11262007151257466").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="11262007151257466" wrap="virtual">
Option Explicit

Dim ql As qual_limit, AgreementAccepted As Boolean
Private Const DelaySeconds As Integer = 5
Private DelaySecondsCnt As Integer

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If AgreementAccepted Then
'run code if Agreement accepted...

Else
'don't run code if Agreement declined...

End If

End Sub

Private Sub Workbook_Open()
SetUpEulaForm
End Sub

Private Sub SetUpEulaForm()
Dim TempEulaPath As String

TempEulaPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "tempEula.htm")

Open TempEulaPath For Output As #1
Print #1, Sheets("Eula").TextBox1.Text
Close #1

Set ql = New qual_limit
ql.WebBrowser1.Navigate TempEulaPath
Application.OnTime Now + TimeSerial(0, 0, 1), ThisWorkbook.CodeName & ".UpdateButton"
ql.Show vbModal
AgreementAccepted = ql.Accepted

If AgreementAccepted Then
MsgBox "Agreement accepted..."
Else
MsgBox "Agreement declined..."
MsgBox "ThisWorkbook.Close False"
End If

On Error Resume Next
Unload ql
Set ql = Nothing
Kill TempEulaPath
End Sub

Private Sub UpdateButton()
On Error Resume Next
DelaySecondsCnt = DelaySecondsCnt + 1
If DelaySecondsCnt >= DelaySeconds Then
ql.Accept.Caption = "Accept"
ql.Accept.Enabled = True
Else
ql.Accept.Caption = "(" & Abs(DelaySecondsCnt - DelaySeconds) & ") Accept"
Application.OnTime Now + TimeSerial(0, 0, 1), ThisWorkbook.CodeName & ".UpdateButton"
End If
End Sub
</textarea>

Legacy 98055 · Nov 26, 2007

Bottom of agreement states:

"If this product was acquired outside of the United States, local lay may apply."

Shame on them...

mhenk · Nov 27, 2007

Alright, that's working pretty well, the web browser thing is pretty sweet One quick tweak I haven't been able to figure out.

When the user clicks "Decline" before the "Accept" Button is enabled, Excel reopens the file. How do I work around that?

Legacy 98055 · Nov 28, 2007

<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Dim ql As qual_limit, AgreementAccepted As Boolean
 Private Const DelaySeconds As Integer = 5
 Private DelaySecondsCnt As Integer
 Private RunNextOnTime As Date

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
 If AgreementAccepted Then
 'run code if Agreement accepted...

 Else
 'don't run code if Agreement declined...

 End If

 End Sub

 Private Sub Workbook_Open()
 SetUpEulaForm
 End Sub

 Private Sub SetUpEulaForm()
 Dim TempEulaPath As String

 TempEulaPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "tempEula.htm")

 Open TempEulaPath For Output As #1
 Print #1, Sheets("Eula").TextBox1.Text
 Close #1

 Set ql = New qual_limit
 ql.WebBrowser1.Navigate TempEulaPath
 RunNextOnTime = Now + TimeSerial(0, 0, 1)
 Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton"
 ql.Show vbModal
 AgreementAccepted = ql.Accepted

 If AgreementAccepted Then
 'MsgBox "Agreement accepted..."
 Else
 'MsgBox "Agreement declined..."
 On Error Resume Next
 Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton", , False
 Unload ql
 Set ql = Nothing
 Kill TempEulaPath
 Me.Close False
 End If

 On Error Resume Next
 Unload ql
 Set ql = Nothing
 Kill TempEulaPath
 End Sub

 Private Sub UpdateButton()
 On Error Resume Next
 DelaySecondsCnt = DelaySecondsCnt + 1
 If DelaySecondsCnt >= DelaySeconds Then
 ql.Accept.Caption = "Accept"
 ql.Accept.Enabled = True
 Else
 ql.Accept.Caption = "(" & Abs(DelaySecondsCnt - DelaySeconds) & ") Accept"
 RunNextOnTime = Now + TimeSerial(0, 0, 1)
 Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton"
 End If
 End Sub

</td></tr></table><button onclick='document.all("1128200742333858").value=document.all("1128200742333858").value.replace(/ \s\s/g,"");document.all("1128200742333858").value=document.all("1128200742333858").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("1128200742333858").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1128200742333858" wrap="virtual">
Option Explicit

Dim ql As qual_limit, AgreementAccepted As Boolean
Private Const DelaySeconds As Integer = 5
Private DelaySecondsCnt As Integer
Private RunNextOnTime As Date

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If AgreementAccepted Then
'run code if Agreement accepted...

Else
'don't run code if Agreement declined...

End If

End Sub

Private Sub Workbook_Open()
SetUpEulaForm
End Sub

Private Sub SetUpEulaForm()
Dim TempEulaPath As String

TempEulaPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "tempEula.htm")

Open TempEulaPath For Output As #1
Print #1, Sheets("Eula").TextBox1.Text
Close #1

Set ql = New qual_limit
ql.WebBrowser1.Navigate TempEulaPath
RunNextOnTime = Now + TimeSerial(0, 0, 1)
Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton"
ql.Show vbModal
AgreementAccepted = ql.Accepted

If AgreementAccepted Then
'MsgBox "Agreement accepted..."
Else
'MsgBox "Agreement declined..."
On Error Resume Next
Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton", , False
Unload ql
Set ql = Nothing
Kill TempEulaPath
Me.Close False
End If

On Error Resume Next
Unload ql
Set ql = Nothing
Kill TempEulaPath
End Sub

Private Sub UpdateButton()
On Error Resume Next
DelaySecondsCnt = DelaySecondsCnt + 1
If DelaySecondsCnt >= DelaySeconds Then
ql.Accept.Caption = "Accept"
ql.Accept.Enabled = True
Else
ql.Accept.Caption = "(" & Abs(DelaySecondsCnt - DelaySeconds) & ") Accept"
RunNextOnTime = Now + TimeSerial(0, 0, 1)
Application.OnTime RunNextOnTime, ThisWorkbook.CodeName & ".UpdateButton"
End If
End Sub
</textarea>

mhenk · Nov 28, 2007

is there something I can put in a BeforeSave routine that will prevent the file from saving?

Legacy 98055 · Nov 28, 2007

Legacy 98055 · Nov 28, 2007

mhenk · Nov 28, 2007

Thanks.

mhenk · Nov 28, 2007

If anyone could tell me how to do this, it'd be much appreciated.

Splash Screen Questions

mhenk

Well-known Member

Legacy 98055

Guest

Legacy 98055

Guest

mhenk

Well-known Member

Legacy 98055

Guest

mhenk

Well-known Member

Legacy 98055

Guest

Legacy 98055

Guest

mhenk

Well-known Member

mhenk

Well-known Member

Similar threads

Share this page

Splash Screen Questions

mhenk

Well-known Member

Legacy 98055

Guest

Legacy 98055

Guest

mhenk

Well-known Member

Legacy 98055

Guest

mhenk

Well-known Member

Legacy 98055

Guest

Legacy 98055

Guest

mhenk

Well-known Member

mhenk

Well-known Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock