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.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.