Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 13
Default dynamically create userform

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.


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I create and display a chart dynamically on a UserForm wi. cc Charts and Charting in Excel 1 February 14th 05 02:44 PM
How to create labels in a UserForm dynamically and be able to resize them with the mouse. Pierre Archambault Excel Programming 0 November 23rd 04 08:39 PM
Create combo box dynamically Duraiswamy Lingappan Excel Programming 9 July 8th 04 05:09 PM
Create controls dynamically Tom Ogilvy Excel Programming 0 November 24th 03 03:37 PM
Dynamically Adding Code to Buttons on an existing UserForm Peter Street Excel Programming 2 September 29th 03 09:54 AM


All times are GMT +1. The time now is 09:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"