Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function replacement/enhancement.
I want to be able to send it custom button labels, and I've figured out how
to do that. I also want to be able to optionally make it disappear after a
certain amount of time, even if the user doesn't choose anything. That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it never closes
itself, and if I do click a button, it gives me a run-time error 1004: Method
'OnTime' of object '_Application' failed. I'm also guessing it's not going
to work so well if I don't send it a number of seconds to autoclose, but I
figure that should be fairly easy to code once I get the rest of it working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As Long = 0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " & TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons) Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth + intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue = " &
intButton
.InsertLines intLineCount + 4, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"", , False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

You may want to consider the alternative of writing an ActiveX control and
simply expose the properties you want to set such as time-before-close,
button labels, form captions etc. In this manner you have a little more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function replacement/enhancement.
I want to be able to send it custom button labels, and I've figured out how
to do that. I also want to be able to optionally make it disappear after a
certain amount of time, even if the user doesn't choose anything. That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it never closes
itself, and if I do click a button, it gives me a run-time error 1004: Method
'OnTime' of object '_Application' failed. I'm also guessing it's not going
to work so well if I don't send it a number of seconds to autoclose, but I
figure that should be fairly easy to code once I get the rest of it working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As Long = 0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " & TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons) Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth + intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue = " &
intButton
.InsertLines intLineCount + 4, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"", , False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

What's the learning curve on writing ActiveX controls? I'm afraid my entire
programming experience is limited to Excel/Access VBA.

"TFS" wrote:

You may want to consider the alternative of writing an ActiveX control and
simply expose the properties you want to set such as time-before-close,
button labels, form captions etc. In this manner you have a little more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function replacement/enhancement.
I want to be able to send it custom button labels, and I've figured out how
to do that. I also want to be able to optionally make it disappear after a
certain amount of time, even if the user doesn't choose anything. That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it never closes
itself, and if I do click a button, it gives me a run-time error 1004: Method
'OnTime' of object '_Application' failed. I'm also guessing it's not going
to work so well if I don't send it a number of seconds to autoclose, but I
figure that should be fairly easy to code once I get the rest of it working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As Long = 0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " & TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons) Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth + intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue = " &
intButton
.InsertLines intLineCount + 4, " Application.OnTime Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"", , False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

Don't even think about it, it is not trivial, and you will have to ship the
control with the workbook.

If you wait time limited msgbox, try

Dim cTime As Long
Dim WSH As Object


Set WSH = CreateObject("WScript.Shell")
cTime = 10 ' 10 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", _
vbOKCancel)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select


As you can see, it can be OK, Cancel or timed out.


If you want a Msgbox with custom button labels, I have some (pretty
unstable) code you can have.


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Janelle" wrote in message
...
What's the learning curve on writing ActiveX controls? I'm afraid my
entire
programming experience is limited to Excel/Access VBA.

"TFS" wrote:

You may want to consider the alternative of writing an ActiveX control
and
simply expose the properties you want to set such as time-before-close,
button labels, form captions etc. In this manner you have a little more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function
replacement/enhancement.
I want to be able to send it custom button labels, and I've figured
out how
to do that. I also want to be able to optionally make it disappear
after a
certain amount of time, even if the user doesn't choose anything.
That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it never
closes
itself, and if I do click a button, it gives me a run-time error 1004:
Method
'OnTime' of object '_Application' failed. I'm also guessing it's not
going
to work so well if I don't send it a number of seconds to autoclose,
but I
figure that should be fairly easy to code once I get the rest of it
working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As
Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As Long =
0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub
UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime Now
+
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " &
TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons)
Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth +
intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue =
" &
intButton
.InsertLines intLineCount + 4, " Application.OnTime
Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"", ,
False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

Actually, I already have code for the "custom msgbox" with custom button
labels using a dynamically created userform, and it seems to be working
pretty well, as far as I can tell. Now I'm just trying to add in something
to make the form close itself after a certain amount of time if no buttons
are clicked.

"Bob Phillips" wrote:

Don't even think about it, it is not trivial, and you will have to ship the
control with the workbook.

If you wait time limited msgbox, try

Dim cTime As Long
Dim WSH As Object


Set WSH = CreateObject("WScript.Shell")
cTime = 10 ' 10 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", _
vbOKCancel)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select


As you can see, it can be OK, Cancel or timed out.


If you want a Msgbox with custom button labels, I have some (pretty
unstable) code you can have.


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Janelle" wrote in message
...
What's the learning curve on writing ActiveX controls? I'm afraid my
entire
programming experience is limited to Excel/Access VBA.

"TFS" wrote:

You may want to consider the alternative of writing an ActiveX control
and
simply expose the properties you want to set such as time-before-close,
button labels, form captions etc. In this manner you have a little more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function
replacement/enhancement.
I want to be able to send it custom button labels, and I've figured
out how
to do that. I also want to be able to optionally make it disappear
after a
certain amount of time, even if the user doesn't choose anything.
That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it never
closes
itself, and if I do click a button, it gives me a run-time error 1004:
Method
'OnTime' of object '_Application' failed. I'm also guessing it's not
going
to work so well if I don't send it a number of seconds to autoclose,
but I
figure that should be fairly easy to code once I get the rest of it
working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As
Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As Long =
0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub
UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime Now
+
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " &
TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons)
Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth +
intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue =
" &
intButton
.InsertLines intLineCount + 4, " Application.OnTime
Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"", ,
False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

This technique by John Walkenbach shows how to drop a userform from a time
limit perspective.

http://j-walk.com/ss/excel/tips/tip39.htm

You would need to adjust it to cancel the ontime event if a button were
pushed,.

--
Regards,
Tom Ogilvy



"Janelle" wrote in message
...
Actually, I already have code for the "custom msgbox" with custom button
labels using a dynamically created userform, and it seems to be working
pretty well, as far as I can tell. Now I'm just trying to add in
something
to make the form close itself after a certain amount of time if no buttons
are clicked.

"Bob Phillips" wrote:

Don't even think about it, it is not trivial, and you will have to ship
the
control with the workbook.

If you wait time limited msgbox, try

Dim cTime As Long
Dim WSH As Object


Set WSH = CreateObject("WScript.Shell")
cTime = 10 ' 10 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", _
vbOKCancel)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select


As you can see, it can be OK, Cancel or timed out.


If you want a Msgbox with custom button labels, I have some (pretty
unstable) code you can have.


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Janelle" wrote in message
...
What's the learning curve on writing ActiveX controls? I'm afraid my
entire
programming experience is limited to Excel/Access VBA.

"TFS" wrote:

You may want to consider the alternative of writing an ActiveX
control
and
simply expose the properties you want to set such as
time-before-close,
button labels, form captions etc. In this manner you have a little
more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function
replacement/enhancement.
I want to be able to send it custom button labels, and I've
figured
out how
to do that. I also want to be able to optionally make it
disappear
after a
certain amount of time, even if the user doesn't choose anything.
That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it
never
closes
itself, and if I do click a button, it gives me a run-time error
1004:
Method
'OnTime' of object '_Application' failed. I'm also guessing it's
not
going
to work so well if I don't send it a number of seconds to
autoclose,
but I
figure that should be fairly easy to code once I get the rest of
it
working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As
Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As
Long =
0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub
UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime
Now
+
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " &
TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel =
TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth +
((UBound(varArrButtons) -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To
LBound(varArrButtons)
Step -1
intTotalButtonWidth = intButtonWidth + ((intButton -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth +
intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width +
intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton"
&
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, "
CustMsgboxValue =
" &
intButton
.InsertLines intLineCount + 4, "
Application.OnTime
Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"",
,
False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight +
10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove
VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

Right, that's what I'm doing now (see code in original post), but for some
reason it's not working. Any idea what might be wrong with my code?

"Tom Ogilvy" wrote:

This technique by John Walkenbach shows how to drop a userform from a time
limit perspective.

http://j-walk.com/ss/excel/tips/tip39.htm

You would need to adjust it to cancel the ontime event if a button were
pushed,.

--
Regards,
Tom Ogilvy



"Janelle" wrote in message
...
Actually, I already have code for the "custom msgbox" with custom button
labels using a dynamically created userform, and it seems to be working
pretty well, as far as I can tell. Now I'm just trying to add in
something
to make the form close itself after a certain amount of time if no buttons
are clicked.

"Bob Phillips" wrote:

Don't even think about it, it is not trivial, and you will have to ship
the
control with the workbook.

If you wait time limited msgbox, try

Dim cTime As Long
Dim WSH As Object


Set WSH = CreateObject("WScript.Shell")
cTime = 10 ' 10 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", _
vbOKCancel)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select


As you can see, it can be OK, Cancel or timed out.


If you want a Msgbox with custom button labels, I have some (pretty
unstable) code you can have.


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Janelle" wrote in message
...
What's the learning curve on writing ActiveX controls? I'm afraid my
entire
programming experience is limited to Excel/Access VBA.

"TFS" wrote:

You may want to consider the alternative of writing an ActiveX
control
and
simply expose the properties you want to set such as
time-before-close,
button labels, form captions etc. In this manner you have a little
more
control of the GUI and portability between apps.

-Todd

http://www.ManagementAnalytics.com

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function
replacement/enhancement.
I want to be able to send it custom button labels, and I've
figured
out how
to do that. I also want to be able to optionally make it
disappear
after a
certain amount of time, even if the user doesn't choose anything.
That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it
never
closes
itself, and if I do click a button, it gives me a run-time error
1004:
Method
'OnTime' of object '_Application' failed. I'm also guessing it's
not
going
to work so well if I don't send it a number of seconds to
autoclose,
but I
figure that should be fairly easy to code once I get the rest of
it
working.

----------------------
Option Explicit

'For CustMsgBox
Public CustMsgBoxValue As Variant

Public Function CustMsgBox(strLabel As String, varArrButtons As
Variant,
Optional strTitle As String, Optional lngSecondsBeforeClose As
Long =
0)

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim TempMod 'As VBComponent
Dim strTempModName As String
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim sngStopTime As Single

CustMsgBox = False
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add timer, if necessary
If lngSecondsBeforeClose 0 Then
sngStopTime = lngSecondsBeforeClose / 86400
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub
UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Application.OnTime
Now
+
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"""
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
Set TempMod = ThisWorkbook.VBProject.VBComponents.Add(1)
strTempModName = "mod" & Format(Now, "yymdhns")
TempMod.Name = strTempModName
With TempMod.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub Close0()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " Unload " &
TempForm.Name
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, "End Sub"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
End If
'Add the Label
intTopPos = 8
Set lblNewLabel =
TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth +
((UBound(varArrButtons) -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To
LBound(varArrButtons)
Step -1
intTotalButtonWidth = intButtonWidth + ((intButton -
1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth +
intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width +
intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton"
&
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, "
CustMsgboxValue =
" &
intButton
.InsertLines intLineCount + 4, "
Application.OnTime
Now +
TimeValue(""" & Format(sngStopTime, "h:mm:ss") & """), ""Close0"",
,
False"
.InsertLines intLineCount + 5, " Unload Me"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, "End Sub"
.InsertLines intLineCount + 8, ""
.InsertLines intLineCount + 9, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight +
10
End With
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove
VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function
----------------------

Ok, I found a different method to try and this one seems to be working so
far. Here's the code, in case anybody else needs something like this. Let
me know if you discover any problems or improvements.

----------
Option Explicit
Public CustMsgBoxValue As Variant


Public Function CustMsgBox(strLabel As String, varArrButtons, Optional
strTitle As String, Optional lngSecondsBeforeClose As Long = 0) As Integer

Const intFormWidth As Integer = 456
Const intButtonWidth As Integer = 60
Const intButtonHeight As Integer = 20
Const intButtonSpacing As Integer = 4

Dim TempForm 'As VBComponent
Dim cmdNewButton As Msforms.CommandButton
Dim lblNewLabel As Msforms.Label
Dim intLineCount As Integer
Dim intButton As Integer
Dim intTopPos As Integer
Dim intLeftPos As Integer
Dim intMaxWidth As Integer
Dim intMaxHeight As Integer
Dim intTotalButtonWidth As Integer
Dim dblCloseTime As Double

dblCloseTime = Now
dblCloseTime = dblCloseTime + (lngSecondsBeforeClose / 86400)
CustMsgBox = -1
CustMsgBoxValue = -1
'Set default title
If strTitle = "" Then
strTitle = Application.Name
End If
'Hide VBE window to prevent screen flashing
' Application.VBE.MainWindow.Visible = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = intFormWidth + 4
'Add opening code
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Option Explicit"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, ""
.InsertLines intLineCount + 4, " Dim dblCloseTime As Double"
.InsertLines intLineCount + 5, " Dim dblNow As Double"
.InsertLines intLineCount + 6, ""
.InsertLines intLineCount + 7, ""
End With
'Add the Label
intTopPos = 8
Set lblNewLabel = TempForm.Designer.Controls.Add("forms.Label.1")
With lblNewLabel
.Top = intTopPos
.Left = 10
.Width = intFormWidth - 20
.Caption = strLabel
.AutoSize = True
.WordWrap = True
intTopPos = intTopPos + .Height + 10
End With
'Figure left button position
intTotalButtonWidth = intButtonWidth + ((UBound(varArrButtons) - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
For intButton = UBound(varArrButtons) To LBound(varArrButtons) Step -1
intTotalButtonWidth = intButtonWidth + ((intButton - 1) *
(intButtonWidth + intButtonSpacing))
If intTotalButtonWidth intFormWidth Then
Else
Exit For
End If
Next intButton
End If
intLeftPos = (intFormWidth - intTotalButtonWidth) / 2
'Add the CommandButtons
' intMaxWidth = 0 'Stores width of widest CommandButton
' intMaxHeight = 0 'Stores height of tallest CommandButton
For intButton = LBound(varArrButtons) To UBound(varArrButtons)
If intButton 1 And intLeftPos + intButtonWidth + intButtonSpacing
intFormWidth Then
Else
Set cmdNewButton =
TempForm.Designer.Controls.Add("forms.CommandButto n.1")
With cmdNewButton
.Caption = varArrButtons(intButton)
.Width = intButtonWidth
.Height = intButtonHeight
.Left = intLeftPos
.Top = intTopPos
' .AutoSize = True
.WordWrap = True
intLeftPos = intLeftPos + .Width + intButtonSpacing
End With
'Add event-hander subs for the CommandButtons
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Sub CommandButton" &
intButton & "_Click()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " CustMsgboxValue = " &
intButton
.InsertLines intLineCount + 4, " Unload Me"
.InsertLines intLineCount + 5, ""
.InsertLines intLineCount + 6, "End Sub"
.InsertLines intLineCount + 7, ""
.InsertLines intLineCount + 8, ""
End With
End If
Next intButton
'Adjust the form
With TempForm
.Properties("Caption") = strTitle
.Properties("Height") = 20 + intTopPos + intButtonHeight + 10
End With
'Add timer to close form
If lngSecondsBeforeClose 0 Then
With TempForm.CodeModule
intLineCount = .CountOfLines
.InsertLines intLineCount + 1, "Private Sub UserForm_Activate()"
.InsertLines intLineCount + 2, ""
.InsertLines intLineCount + 3, " dblCloseTime = " &
dblCloseTime
.InsertLines intLineCount + 4, ""
.InsertLines intLineCount + 5, " dblNow = Now"
.InsertLines intLineCount + 6, " Do until dblNow
dblCloseTime"
.InsertLines intLineCount + 7, " If CustMsgBoxValue -1
then"
.InsertLines intLineCount + 8, " Exit Do"
.InsertLines intLineCount + 9, " Else"
.InsertLines intLineCount + 10, " DoEvents"
.InsertLines intLineCount + 11, " dblNow = Now"
.InsertLines intLineCount + 12, " End If"
.InsertLines intLineCount + 13, " Loop"
.InsertLines intLineCount + 14, " Unload Me"
.InsertLines intLineCount + 15, ""
.InsertLines intLineCount + 16, "End Sub"
.InsertLines intLineCount + 17, ""
.InsertLines intLineCount + 18, ""
End With
End If
'Show the form
VBA.UserForms.Add(TempForm.Name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
'Pass the selected option back to the calling procedure
CustMsgBox = CustMsgBoxValue

End Function

----------

"Janelle" wrote:

Ok, this is driving me crazy. Can anybody help? Please?

What I want is basically a custom MsgBox function
replacement/enhancement.
I want to be able to send it custom button labels, and I've
figured
out how
to do that. I also want to be able to optionally make it
disappear
after a
certain amount of time, even if the user doesn't choose anything.
That's the
part that's now giving me problems.
Here's what I've got so far, but if I don't click a button, it
never
closes
itself, and if I do click a button, it gives me a run-time error
1004:
Method
'OnTime' of object '_Application' failed. I'm also guessing it's
not
going
to work so well if I don't send it a number of seconds to
autoclose,
but I
figure that should be fairly easy to code once I get the rest of
it
working.