PDA

View Full Version : Create a control dynamically with an event and progressbar



pleth
10-28-2007, 08:20 AM
Hello,

I have spent a lot of time finding a solution for my problems but I am still blocked :banghead:

Here is a sample of my code :


Private sub test()
Dim cpt,nb_usage,size as Integer
cpt = 1
nb_usage = 1
size = 30
While ActiveWorkbook.Sheets(idSheet).Range("E" & cpt).FormulaR1C1 <> ""
Set Obj = UserForm1.FrameUsage.Controls.Add("Forms.CheckBox.1")
With Obj
.Name = "C" & nb_usage
.Object.Caption = ActiveWorkbook.Sheets(idSheet).Range("D" & cpt).FormulaR1C1
.Left = 6
.Top = 25 + size
.Width = 120
.Height = 35
.Visible = True
.ForeColor = &H0&
.FontBold = False
.FontSize = 8
End With
AddHandler("Check" & nb_usage).Change , AddressOf abc
cpt = cpt + 1
size = size + 30
nb_usage = nb_usage + 1
Wend
End Sub

Private Sub abc()
MsgBox ("test")
End Sub


The checkbox is created but the problem is the AddHandler. Excel told me that AddressOf is not correct... ?? :bug: *


Other problem :

I want to create a progressbar dynamically but the following syntax is not working :

Set Obj2 = UserForm1.FrameUsage.Controls.Add("Forms.ProgressBar.1")
With Obj2
.Name = "P" & nb_usage
.Object.ControlTipText = "10%"
.Left = 130
.Top = 25 + size
.Width = 50
.Height = 20
.Visible = True
End With


Forms.ProgressBar is unknow ... :think:

Somebody helps ? Thank you !:thumb

Norie
10-28-2007, 09:59 AM
Well Excel is right about AddressOf, that doesn't exist in VBA.

Why are you adding controls on the fly?

pleth
10-28-2007, 11:00 AM
Well Excel is right about AddressOf, that doesn't exist in VBA.

Why are you adding controls on the fly?

Depend on the user's choice, i can show one or many checkboxes on the form so I need to generate them dynamically. Is there another solution ? :think:

Bob Phillips
10-28-2007, 11:03 AM
Well Excel is right about AddressOf, that doesn't exist in VBA.

AddressOf Operator


A unary operator that causes the address of the procedure it precedes to be passed to an API procedure that expects a function pointer at that position in the argument list.

Syntax

AddressOf procedurename

The required procedurename specifies the procedure whose address is to be passed. It must represent a procedure in a standard module module in the project in which the call is made.

Remarks

When a procedure name appears in an argument list, usually the procedure is evaluated, and the address of the procedure’s return value is passed. AddressOf permits the address of the procedure to be passed to a Windows API function in a dynamic-link library (DLL), rather passing the procedure's return value. The API function can then use the address to call the Basic procedure, a process known as a callback. The AddressOf operator appears only in the call to the API procedure.

Although you can use AddressOf to pass procedure pointers among Basic procedures, you can't call a function through such a pointer from within Basic. This means, for example, that a class written in Basic can't make a callback to its controller using such a pointer. When using AddressOf to pass a procedure pointer among procedures within Basic, the parameter of the called procedure must be typed As Long.

Warning Using AddressOf may cause unpredictable results if you don't completely understand the concept of function callbacks. You must understand how the Basic portion of the callback works, and also the code of the DLL into which you are passing your function address. Debugging such interactions is difficult since the program runs in the same process as the development environment. In some cases, systematic debugging may not be possible.

Note You can create your own call-back function prototypes in DLLs compiled with Microsoft Visual C++ (or similar tools). To work with AddressOf, your prototype must use the __stdcall calling convention. The default calling convention (__cdecl) will not work with AddressOf.

Since the caller of a callback is not within your program, it is important that an error in the callback procedure not be propagated back to the caller. You can accomplish this by placing the On Error Resume Next statement at the beginning of the callback procedure.

Bob Phillips
10-28-2007, 11:04 AM
Depend on the user's choice, i can show one or many checkboxes on the form so I need to generate them dynamically. Is there another solution ? :think:

Yes, create them all in design mode and then hide/unhide as required.

Zack Barresse
10-28-2007, 11:04 AM
Are you just looking for a progress box? If so, here is some code which will create one for you. Add a userform, name it ProgressBox, add the following code to its module...
Option Explicit

Private Const DefaultTitle = "Progress"
Private myText As String
Private myPercent As Single

' Text property shows user-defined text above the progress bar
Public Property Let Text(newText As String)
If newText <> myText Then
myText = newText
Me.Controls("UserText").Caption = myText
Call sizeToFit
End If
End Property

Public Property Get Text() As String
Text = myText
End Property

' Percent property alters the progress bar
Public Property Let Percent(newPercent As Single)
If newPercent <> myPercent Then
' limit percent to between 0 and 100
myPercent = WorksheetFunction.Min(WorksheetFunction.Max(newPercent, 0#), 100#)
Call updateProgress
End If
End Property

Public Property Get Percent() As Single
Percent = myPercent
End Property

' Increment method enables the percent and optionally the text to be updated at same time
Public Sub Increment(ByVal newPercent As Single, Optional ByVal newText As String)
Me.Percent = newPercent
If newText <> "" Then Me.Text = newText
Call updateTitle
Me.Repaint
End Sub

' Setup the progress dialog - title, control layout/size etc.
Private Sub UserForm_Initialize()
Call setupControls
Call updateTitle
End Sub

' Prevents use of the Close button
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

' Removes any current controls, add the needed controls ...
Private Sub setupControls()
Dim i As Integer
Dim aControl As Object ' Label
' remove existing controls
For i = Me.Controls.Count To 1 Step -1
Me.Controls(i).Remove
Next i
' add user text - don't worry about positioning as "sizeToFit" takes care of this
Set aControl = Me.Controls.Add("Forms.Label.1", "UserText", True)
aControl.Caption = ""
aControl.AutoSize = True
aControl.WordWrap = True
aControl.Font.Size = 8
' add progressFrame - don't worry about positioning as "sizeToFit" takes care of this
Set aControl = Me.Controls.Add("Forms.Label.1", "ProgressFrame", True)
aControl.Caption = ""
aControl.Height = 16
aControl.SpecialEffect = fmSpecialEffectSunken
' add user text - don't worry about positioning as "sizeToFit" takes care of this
Set aControl = Me.Controls.Add("Forms.Label.1", "ProgressBar", True)
aControl.Caption = ""
aControl.Height = 14
aControl.BackStyle = fmBackStyleOpaque
aControl.BackColor = &HFF0000 ' Blue
' position the controls and size the progressBox
Call sizeToFit
End Sub


' Adjusts positioning of controls/size of form depending on size of user text
Private Sub sizeToFit()
' setup width of progress box
Me.Width = 240
' user-supplied text should be topmost, taking up the appropriate size ...
Me.Controls("UserText").Top = 6
Me.Controls("UserText").Left = 6
Me.Controls("UserText").AutoSize = False
Me.Controls("UserText").Font.Size = 8
Me.Controls("UserText").Width = Me.InsideWidth - 12
Me.Controls("UserText").AutoSize = True
' progress frame/bar should be below user text
Me.Controls("ProgressFrame").Top = Int(Me.Controls("UserText").Top + Me.Controls("UserText").Height) + 6
Me.Controls("ProgressFrame").Left = 6
Me.Controls("ProgressFrame").Width = Me.InsideWidth - 12
Me.Controls("ProgressBar").Top = Me.Controls("ProgressFrame").Top + 1
Me.Controls("ProgressBar").Left = Me.Controls("ProgressFrame").Left + 1
Call updateProgress ' update ProgressBar width
' finally, height of progress box should fit around text and progress bar & allow for title/box frame
Me.Height = Me.Controls("ProgressFrame").Top + Me.Controls("ProgressFrame").Height + 6 + (Me.Height - Me.InsideHeight)
End Sub

' updates the caption of the progress box to keep track of progress
Private Sub updateTitle()
If (Int(myPercent) Mod 5) = 0 Then
Me.Caption = DefaultTitle & " - " & Format(Int(myPercent), "0") & "% Complete"
End If
End Sub

' updates the width of the progress bar to match the current percentage
Private Sub updateProgress()
If myPercent = 0 Then
Me.Controls("ProgressBar").Visible = False
Else
Me.Controls("ProgressBar").Visible = True
Me.Controls("ProgressBar").Width = Int((Me.Controls("ProgressFrame").Width - 2) * myPercent / 100)
End If
End Sub

Call from a standard module like this ...
Option Explicit

Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Sub TestPB()

Dim frmProgress As New ProgressBox, i As Long, j As Long
frmProgress.Show
For i = 1 To 100
Sleep 50
frmProgress.Increment i, i & "% complete..."
Next i
frmProgress.Hide

End Sub
The sleep API is obviously optional, just used for example purposes.

HTH

Norie
10-28-2007, 11:30 AM
Pleth

Could you not use another control, perhaps a listbox?

If you really want checkboxes it's properties can be set to show them for each item in the list.

xld

AddressOf is not available in earlier versions of Excel VBA as far as I'm aware.

Bob Phillips
10-28-2007, 01:05 PM
xld

AddressOf is not available in earlier versions of Excel VBA as far as I'm aware.

That is not what you said, you said it doesn't exist.

And it is easily emulated in 97.

Norie
10-28-2007, 01:33 PM
xld

Sorry for not phrasing my post correctly.:)

I know it can be emulated in earlier versions but I would actually question why the OP wants/needs it in the first place.

pleth
10-28-2007, 04:10 PM
First, thank you for all your replies.:bow:
Ok now I am using this solution :

I have created 10 checkboxes not visible on my form named c1 to c10. And this is my code to manage that


While ActiveWorkbook.Sheets(idSheet).Range("E" & cpt).FormulaR1C1 <> ""
Set Obj = UserForm1.Controls("c" & cpt_check)
With Obj
.Object.Caption = ActiveWorkbook.Sheets(idSheet).Range("D" & cpt).FormulaR1C1
.Visible = True
End With
UserForm1.Controls("p" & cpt_check).Visible = True
cpt = cpt + 1
cpt_check = cpt_check + 1
Wend



Now the problem is I would like to change the name of the checkboxes to know what checkbox the user has checked.

Example :

I want to change "c1" to "house" to get this name when the user check the box. But now Excel told me that it cannot change the name while running... :(

An idea ? Thank you!

Norie
10-28-2007, 04:27 PM
Yes, don't create the checkboxes dynamically.:)

Bob Phillips
10-28-2007, 06:09 PM
You are not at all clear.

Why would you need to change the name of the checkbox? The caption maybe I could understand, but not the name.

I assume that you have given up on creating the controls dynamically.

mikerickson
10-28-2007, 06:15 PM
You can change the caption, but leave the name the same.
Or you could declare

Public houseControl as Objectin a normal module
and

Private Sub CheckBox1_Click()
Set houseControl = Me.CheckBox1
Rem more code
End Subrather than renaming each control as it is checked.