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

Excel Facts

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

Forum statistics

Share this page

Splash Screen Questions

mhenk

Well-known Member

Legacy 98055

Guest

Excel Facts

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

Forum statistics

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