clsCommandButton: Microsoft Excel VBA - Run-Time Error '-2147024809 (80070057)' - vba

I want to add dynamically CommandButtons to my Userform within the For-Loop. How can i get add new CommandButtons in the For-Loop?
Dim CommandButtons(5) As clsCommandButtons
Private Sub UserForm_Initialize()
Dim zaehler As Integer
For zaehler = 0 To 4
Set CommandButtons(zaehler) = New clsCommandButtons
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler)
Next
End Sub
And This is my class:
Option Explicit
Public WithEvents cmdCommandButton As CommandButton
Private Sub cmdCommandButton_Click()
Dim sFilepath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = ActiveWorkbook.Path & "\"
.Filters.Add "TextFiles", "*.txt", 1
.FilterIndex = 1
If .Show = -1 Then
sFilepath = .SelectedItems(1)
End If
End With
Cells(c_intRowFilterPathStart, c_intClmnFilterPath) = sFilepath
End Sub
I don't know how to handle this Error. How can i fix this?

I assume you get the error because you're accessing a control that doesn't exist. Note that the controls are counted from 0 to Me.Controls.count-1, so probably your issue is solved with
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler-1)
But I guess a better solution is to name your buttons and assign them by name:
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls("CommandButton" & zaehler)

Define the CommandButtons collection as a Variant:
Dim CommandButtons(15) As Variant, instead of Dim CommandButtons(15) As clsCommandButtons.
In this Variant, you would put your CommandButtons. This is some minimal code, that would help you get the basics of what I mean:
CustomClass:
Private Sub Class_Initialize()
Debug.Print "I am initialized!"
End Sub
In a module:
Private SomeCollection(4) As Variant
Public Sub TestMe()
Dim cnt As Long
For cnt = 1 To 4
Set SomeCollection(cnt) = New CustomClass
Next cnt
End Sub
From this small running code, you can start debugging further :)

I think your problem is in the Me.Controls(zaehler) part. zaehler starts at 1, but Me.Controls(...) starts at 0.
Set CommandButtons(zaehler).cmdCommandButton = Me.Controls(zaehler - 1)
would probably solve it

Dim a() As clsCommandButton
Private Sub UserForm_Initialize()
Dim c As Control
On Error GoTo eHandle
For Each c In Me.Controls
If TypeName(c) = "CommandButton" Then
ReDim Preserve a(UBound(a) + 1)
Set a(UBound(a)) = New clsCommandButton
Set a(UBound(a)).cmd = c
End If
Next c
Exit Sub
eHandle:
If Err.Number = 9 Then
ReDim a(0)
End If
Resume Next
End Sub
With a class as follows
Public WithEvents cmd As commandbutton
Private Sub cmd_Click()
MsgBox "test"
End Sub

Related

Excel VBA Userform - Execute Sub when something changes on dynamic comboBox

I created a userform where is a comboBox
Depending which result user chooses, new comboBoxes will appear with new choices to choose from.
Below is the latest test I tried.
How do I make it so that when user changes the value in the new comboBox it will execute a premade function/sub
Code in Form
Dim WB As Workbook
Dim structSheet As Worksheet
Dim tbCollection As Collection
Private Sub UserForm_Activate()
Dim ignoreList(3) As String
ignoreList(0) = "main"
ignoreList(1) = "configurator"
ignoreList(2) = "create structure"
Set WB = Excel.ActiveWorkbook
For Each sheet In WB.Worksheets
If Not isInTable(ignoreList, sheet.Name) Then
supercode_box.AddItem sheet.Name
End If
Next
End Sub
Private Sub supercode_box_Change()
If Not sheetExists(supercode_box.text) Then Exit Sub
Set structSheet = WB.Worksheets(supercode_box.text)
'Dim obj As clsControlBox
topPos = 10
leftPos = 54
ID = 1
' For ID = 1 To 2
Set ComboBox = createProductForm.Controls.add("Forms.ComboBox.1")
With ComboBox
.Name = "comboBoxName"
.Height = 16
.Width = 100
.Left = leftPos
.Top = topPos + ID * 18
.AddItem "test"
.Object.Style = 2
End With
Set tbCollection = New Collection
tbCollection.add ComboBox
'Next ID
End Sub
code in class1 module
Private WithEvents MyTextBox As MSForms.controlBox
Public Property Set Control(tb As MSForms.controlBox)
Set MyTextBox = tb
MsgBox ("did it get here?")
End Property
Public Sub comboBoxName_Change()
MsgBox ("start working ffs")
End Sub
Public Sub comboBoxName()
MsgBox ("?? maybe this?")
End Sub
Judging on your code, the easiest way is to write the value you need in a separate worksheet.
Then make a check, whether it is changed and if it is changed, write the new value and fire the procedure that you want.
In short, something like this:
Sub TestMe()
If Worksheets("Special").Cells(1, 1) = WB.Worksheets(supercode_box.Text) Then
Call TheSpecificSub
End If
Worksheets("Special").Cells(1, 1) = WB.Worksheets(supercode_box.Text)
End Sub

Is there a way to simplify the code in VBA in PowerPoint?

(1*8)+(2*8)+(3*8)+(4*8)+(5*8) be written as (1+2+3+4+5)*8.
How can I simplify the code below in a similar way?
Private Sub CommandButton1_Click()
Label1.BackColor = &H8000000F
Label2.BackColor = &H8000000F
Label3.BackColor = &H8000000F
Label4.BackColor = &H8000000F
Label5.BackColor = &H8000000F
End Sub
Actually I have heard of a solution that uses With, but so far I never get to see them applied in PowerPoint.
you can't use With keyword for such a task
but you can do this:
Private Sub CommandButton1_Click()
Dim i As Long
For i = 1 To 5
Me.Controls("Label" & i).BackColor = &H8000000F
Next i
End Sub
Create a range for the labels and call it by range as opposed to label.
Private Sub CommandButton1_Click()
rangeName = &H8000000F
End Sub

excel 2010 vba how can i declare a listbox?

I have a userform which has the following bit of code included:
Private Sub RemoveRecipientCommandButton_Click()
Application.ScreenUpdating = False
Dim intCount As Integer
For intCount = RecipientsListBox.ListCount - 1 To 0 Step -1
If RecipientsListBox.Selected(intCount) Then RecipientsListBox.RemoveItem (intCount)
Next intCount
Application.ScreenUpdating = True
End Sub
This code is run on a listbox which is MultiSelect 1 - fmMultiSelectMulti, and works just fine. The problem comes when I try to allow parameters to be passed to it, so I can use the same sub on more than one ListBox. I've tried:
Private Sub RemoveRecipientCommandButton_Click()
Application.ScreenUpdating = False
RemoveSelected (RecipientsListBox)
Application.ScreenUpdating = True
End Sub
with
Private Sub RemoveSelected(LB As ListBox)
Dim intCount As Integer
For intCount = LB.ListCount - 1 To 0 Step -1
If LB.Selected(intCount) Then LB.RemoveItem (intCount)
Next intCount
End Sub
I've also tried:
Private Sub RemoveSelected(LB As MSForms.ListBox)
and as
Private Sub RemoveSelected(LB As ListObject)
with the rest of the RemoveSelected code being the same. All of these forms of this code throw Error 424 - object required. I'm by no means an Excel pro, so my main concern here is just finding code that works - I want to be able to make this into something I can use on more than one ListBox, if necessary, without having to write the code as new for each ListBox. If someone could even point me in the right direction, I'd appreciate any help I can get. Thanks.
Multiple issues here.
Don't wrap parameters in parentheses calling Subs without Call.
So either Call RemoveSelected(RecipientsListBox) or RemoveSelected RecipientsListBox.
Default modus to hand over parameter is ByRef but that's not possible here. So using ByValis needed.
Correct type is MSForms.ListBox
Code:
Private Sub RemoveRecipientCommandButton_Click()
Application.ScreenUpdating = False
RemoveSelected RecipientsListBox
'Call RemoveSelected(RecipientsListBox)
Application.ScreenUpdating = True
End Sub
Private Sub RemoveSelected(ByVal LB As MSForms.ListBox)
Dim intCount As Integer
For intCount = LB.ListCount - 1 To 0 Step -1
If LB.Selected(intCount) Then LB.RemoveItem intCount
Next intCount
End Sub
Edit:
As #Patrick Lepelletier stated, ByRef is possible in this case. I had the Control object stored in a local variable Set oListboxControl = RecipientsListBox : RemoveSelected oListboxControl what caused the problem with ByRef
So
Private Sub RemoveSelected(LB As MSForms.ListBox)
Dim intCount As Integer
For intCount = LB.ListCount - 1 To 0 Step -1
If LB.Selected(intCount) Then LB.RemoveItem intCount
Next intCount
End Sub
will also work.

Creating a Command Button Class - For Word Command Buttons

I am trying to set some command buttons properties out in bulk . That is trying to set various properties of the command buttons in one go rather than repeat the code for each command button individually.
The document has 30+ command buttons.
In the Class - I have put the code below:
Option Explicit
Public WithEvents cMDButtonGroup As CommandButton
Private Sub cMDButtonGroup_Click()
With cMDButtonGroup
If .Caption = "Press" Then
' Add some other button properties
Else
.Caption = " Complete"
End If
End With
In a VBA Module - I have put the code below:
Option Explicit
Dim Buttons() As New cMDButtonClass
Sub Buttons()
Dim ButtonCount As Integer
Dim ctl As Control
' Create the Button objects
ButtonCount = 0
For Each ctl In ActiveDocument.Controls ' This may be wrong
If TypeName(ctl) = "CommandButton" Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = ctl
End If
End If
Next ctl
End Sub
The above may have been sourced from VBA Express? Unfortunately I have lost the link.
Unfortunately I do not know how to proceed to fix this.
Final Solution: Tim's Code works perfectly. You also need to load the buttons
Put the below code in ThisDocument
Private Sub Document_Open()
Call SetupButtons
End Sub
cMDButtonClass (simplified)
Public WithEvents oBtn As CommandButton
Private Sub oBtn_Click()
MsgBox "clicked: " & oBtn.Caption
End Sub
In a regular module:
Dim colButtons As New Collection '< simpler to manage than an array
Sub SetupButtons()
Dim ButtonCount As Integer
Dim ctl, c
Dim oB As cMDButtonClass
'Following Cindy's comment...
For Each ctl In ActiveDocument.InlineShapes
If Not ctl.OLEFormat Is Nothing Then
Set c = ctl.OLEFormat.Object
If TypeName(c) = "CommandButton" Then
Set oB = New cMDButtonClass
Set oB.oBtn = c
colButtons.Add oB
End If
End If
Next ctl
End Sub

Close UserForm from Module

I am trying to Close a User Form from a module, but it's not working.
Here is what I have tried
Sub UpdateSheetButton()
Dim subStr1 As String
Dim subSrrt2() As String
Dim tmp As Integer
Dim pos As Integer
Dim Form As WaitMessage
Set Form = New WaitMessage
With Form
.Message_wait = Module2.Label_PleaseWait
.Show
End With
For Each Cell In ActiveSheet.UsedRange.Cells
subStr1 = RemoveTextBetween(Cell.formula, "'C:\", "\AddIns\XL-EZ Addin.xla'!")
tmp = Len(subStr1) < 1
If tmp >= 0 Then
Cell.formula = subStr1
status = True
End If
Next
Unload Form
MsgBox Module2.Label_ProcessComplete
End Sub
Form Name is WaitMessage.
I have also tried WaitMessage.Hide but it's also not working.
Considering a modeless form, create a subroutine within the userform:
Sub UnloadThisForm ()
unload me
End Sub
and call the sub from outside the userform;
call Userform1.UnloadThisForm
Another possibility could be to put your code to ClassModule and to use Events to callback to WaitMessage user form. Here short example. HTH
Standard module creates the form and the updater object and displays the form which starts processing:
Public Sub Main()
Dim myUpdater As Updater
Dim myRange As Range
Dim myWaitMessage As WaitMessage
Set myRange = ActiveSheet.UsedRange.Cells
Set myUpdater = New Updater
Set myUpdater.SourceRange = myRange
' create and initialize the form
Set myWaitMessage = New WaitMessage
With myWaitMessage
.Caption = "Wait message"
Set .UpdaterObject = myUpdater
' ... etc.
.Show
End With
MsgBox "Module2.Label_ProcessComplete"
End Sub
Class module containes the monitored method and has events which are raised if progress updated or finished. In the event some information is send to the form, here it is the number of processed cells but it can be anything else:
Public Event Updated(updatedCellsCount As Long)
Public Event Finished()
Public CancelProcess As Boolean
Public SourceRange As Range
Public Sub UpdateSheetButton()
Dim subStr1 As String
Dim subSrrt2() As String
Dim tmp As Integer
Dim pos As Integer
Dim changesCount As Long
Dim myCell As Range
Dim Status
' process task and call back to form via event and update it
For Each myCell In SourceRange.Cells
' check CancelProcess variable which is set by the form cancel-process button
If CancelProcess Then _
Exit For
subStr1 = "" ' RemoveTextBetween(Cell.Formula, "'C:\", "\AddIns\XL-EZ Addin.xla'!")
tmp = Len(subStr1) < 1
If tmp >= 0 Then
myCell.Formula = subStr1
Status = True
End If
changesCount = changesCount + 1
RaiseEvent Updated(changesCount)
DoEvents
Next
RaiseEvent Finished
End Sub
User form has instance of updater class declared with 'WithEvent' keyword and handles events of it. Here form updates a label on 'Updated' event and unloads itself on 'Finished' event:
Public WithEvents UpdaterObject As Updater
Private Sub UpdaterObject_Finished()
Unload Me
End Sub
Private Sub UpdaterObject_Updated(updatedCellsCount As Long)
progressLabel.Caption = updatedCellsCount
End Sub
Private Sub UserForm_Activate()
UpdaterObject.UpdateSheetButton
End Sub
Private Sub cancelButton_Click()
UpdaterObject.CancelProcess = True
End Sub
A userform is an object in it's own right, you do not need to declare or set as a variable. Also, when you use the .Show Method it will set the Modal property to True by default, which will pause code execution until the user interacts in some way (i.e. closes the form).
You can get around this by using a boolean declaration after the .Show method to specify if the userform is to be shown modal.
Try this instead:
Sub UpdateSheetButton()
Dim subStr1 As String
Dim subSrrt2() As String
Dim tmp As Integer
Dim pos As Integer
With WaitMessage
.Message_wait = Module2.Label_PleaseWait
.Show False
End With
For Each Cell In ActiveSheet.UsedRange.Cells
subStr1 = RemoveTextBetween(Cell.Formula, "'C:\", "\AddIns\XL-EZ Addin.xla'!")
tmp = Len(subStr1) < 1
If tmp >= 0 Then
Cell.Formula = subStr1
Status = True
End If
Next
Unload WaitMessage
MsgBox Module2.Label_ProcessComplete
End Sub
i guess you can do yourself the screenupdating and enableevents, so here is :
(next time add more description to what you are trying to do, and no just post code...)
Option Explicit 'might help to avoid future miss declaring of variables...
Sub UpdateSheetButton()
Dim subStr1 As String
'Dim subSrrt2() As String 'not used in shown code !
'Dim tmp As Integer
Dim pos As Long
Dim Cell as Range 'you forgot to declare this
Dim Form As object
Set Form = New WaitMessage
load Form
With Form
.Message_wait = Module2.Label_PleaseWait
.Show false 'if you ommit false, the code won't continue from this point unless the Form is closed !
End With
For Each Cell In ActiveSheet.UsedRange.Cells
subStr1 = RemoveTextBetween(Cell.formula, "'C:\", "\AddIns\XL-EZ Addin.xla'!")
'tmp = Len(subStr1) < 1 'might replace with a boolean (true/false, instead 0/-1)
'If tmp >= 0 Then 'you don't use tmp later, so i guess its just using variables without need
if substr1<>"" then 'why use a cannon to put a nail in a wall?, go to the point
Cell.formula = subStr1
pos = pos+1 'you declared pos but didn't use it !?
Form.SomeTextbox.caption = pos 'or other counter
'can also use the .width property of a button or picture... to make a progression bar.
status = True 'Status is not declared , and not used elsewhere , so what ?!
End If
Next
Unload Form
set Form = Nothing
MsgBox Module2.Label_ProcessComplete
End Sub