I have a userform that has a text box and whatever value is put into the textbox will determine the number of dynamic controls that are added to the user form and then there is a button and once that is clicked I want the dynamic controls to be removed from the userform altogether.
Below shows the code that is used to create the dynamic controls and this code works perfectly
For i = 1 To TextBox1.Value
newPosition = 360
Set cLabel = Me.Controls.Add("Forms.Label.1")
With cLabel
.Caption = "Label " & (i)
.Font.Size = 8
.Font.Bold = True
.Font.Name = "Tahoma"
'.Left = 70
.Left = 36
.Top = switchBoardLevel
.Width = 130
End With
switchBoardLevel = switchBoardLevel + newPosition
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Caption = "Calculate"
.Left = 300
.Top = buttonStartPosition
.Width = 45
.Height = 18
End With
ReDim Preserve TextListBox(1 To i)
Set TextListBox(i).ButtonGroup = cButton
buttonStartPosition = buttonStartPosition + newPosition
Next i
However there is a problem when it comes to removing the dynamically created controls. I have tried numerous ways to remove the controls. The code below is executed when the button is clicked to remove the controls but it just won't work for me and I am going round in circles so It would be greatly appreciated if someone could give me some guidance on the issue.
For Each TextListBox(i).ButtonGroup In Me.Controls
If (TypeOf TextListBox(i).ButtonGroup Is CommandButton) Then
TextListBox(i).ButtonGroup.Visible = False
End If
Next
You haven't given a lot of information but you can't loop that way - you need to loop through the array:
For i = Lbound(TextListBox) to UBound(TextListBox)
If TypeOf TextListBox(i).ButtonGroup Is MSForms.CommandButton Then
TextListBox(i).ButtonGroup.Visible = False
End If
Next
Related
My issue concerns deleting textboxes dynamically on my userform. On the userform there is a spin button which the user can use to create textboxes at their discretion. As I spin the spin button upwards it will create text boxes up to a maximum amount which I set. However when I spin the button backwards it will only delete the most recently created text box and will not delete any more.
The Code creating the boxes is as follows
Private Sub AgendaFromBox_Change()
Dim BoxValue As Integer
BoxValue = AgendaFromBox.Value
If BoxValue > 10 Then
AgendaFromBox.Value = 10
Exit Sub
End If
If BoxValue = 0 Then
Exit Sub
End If
Dim NewBox As Control
Dim NewLabel As Control
For i = 1 To BoxValue
Set NewBox = Me.Controls.Add("Forms.Textbox.1")
Set NewLabel = Me.Controls.Add("Forms.Label.1")
With NewBox
.Name = "AgendaBox" & i
.Top = 100 + 30 * i
.Left = 20
.Width = 100
.Height = 20
.ControlSource = "'Hidden'!C" & 2 + i
End With
With NewLabel
.Name = "AgendaLabel" & i
.Top = 100 + 30 * i
.Left = 5
.Width = 14
.Height = 20
.Caption = i & "."
End With
Worksheets("Hidden").Range("B" & 2 + i) = i
Next i
NumOutBefore = BoxValue
End Sub
This code is part of a change event for a textbox that is linked to the spin button. The code for deleting the boxes is as follows.
Private Sub AgendaFromSpinner_Change()
AgendaFromBox.Value = AgendaFromSpinner.Value
Dim BoxValue1 As Integer
Static NumOutBefore As Integer
BoxValue1 = AgendaFromBox.Value
If BoxValue1 > 9 Then Exit Sub
If BoxValue1 < 1 Then Exit Sub
If BoxValue1 < NumOutBefore Then
Controls.Remove "AgendaBox" & i
Controls.Remove "AgendaLabel" & i
End If
NumOutBefore = AgendaFromSpinner.Value
End Sub
This code is part of the spin button change event. Any thoughts or ideas would be helpful. Thank you in advance.
I think this is what's happening in your code. If you set a break point on the first line of each module, then step through the code after clicking the spinner up/down buttons, you should be able to verify this:
Spinner starts at 0
Click the spinner UP button.
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1
Spinner UP button is clicked
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1 & AgendaBox2
You now have 2 copies of Agendabox1.
Since VBA won't like that, the second one gets automatically renamed to something
Spinner UP button is clicked
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1, AgendaBox2 & AgendaBox3
You now have 2 copies of Agendabox2 and 3 copies of AgendaBox1
VBA automatically renames the duplicates to something
Spinner DOWN button is clicked
Spinner value is decremented
Box value is decremented.
AgendaFromBox_Change() gets triggered and builds another AgendaBox1 & AgendaBox2
You now have 4 copies of AgendaBox1, two of them with randomly assigned names and 3 copies of AgendaBox2
Names might not be random, but they're not what you're expecting.
AgendaFromSpinner_change() continues to execute, deletes AgendaBox3
Spinner DOWN button is clicked
Spinner value is decremented
Box value is decremented.
AgendaFromBox_Change() gets triggered and builds another AgendaBox1
You now have 5 copies of AgendaBox1
AgendaFromSpinner_change() continues to execute, deletes AgendaBox2, but there's already at least one other AgendaBox2something that remains visible, so it looks like it didn't delete it.
To solve the issue, this should work:
Private Sub AgendaFromBox_Change()
Static BoxValue As Integer
if BoxValue > AgendaFromBox.Value then
'we need to update BoxValue no matter what
BoxValue = AgendaFromBox.Value
'we're decrementing the spinner - we don't need to do anything else here
Exit sub
else
'we need to update BoxValue no matter what
BoxValue = AgendaFromBox.Value
end if
If BoxValue > 10 Then
AgendaFromBox.Value = 10
Exit Sub
End If
If BoxValue = 0 Then
Exit Sub
End If
Dim NewBox As Control
Dim NewLabel As Control
Set NewBox = Me.Controls.Add("Forms.Textbox.1")
Set NewLabel = Me.Controls.Add("Forms.Label.1")
With NewBox
.Name = "AgendaBox" & boxvalue
.Top = 100 + 30 * boxvalue
.Left = 20
.Width = 100
.Height = 20
.ControlSource = "'Hidden'!C" & 2 + boxvalue
End With
With NewLabel
.Name = "AgendaLabel" & boxvalue
.Top = 100 + 30 * boxvalue
.Left = 5
.Width = 14
.Height = 20
.Caption = boxvalue & "."
End With
Worksheets("Hidden").Range("B" & 2 + i) = boxvalue
'not sure where this came from or what it does.
'I don't see it declared anywhere
NumOutBefore = BoxValue
End Sub
My guess is that you do NOT have Option Explicit declared in your module or that NumOutBefore is declared publicly at the top of the module. Make sure you have Option Explicit declared - it will save trouble later
I'm having an issue in Excel 2007 VBA whereby I'm trying to set the visible property to false on a frame within a UserForm.
Userform1.Frame1.Visible = False
When trying to set the property, excel throws the error:
Run-time error '-2147418113 (8000ffff)':
Could not set the Visible property. Unexpected call to method or property access.
I've researched this and the only thing that I've uncovered is that it might be something to do with not having a control to take the focus. In my case this is not true though as there is a button available to take the focus on another frame. The other frame is set to be visible prior to Frame1 being hidden.
Has anyone else experienced this issue or can help me understand what is causing this error?
Edit - Code Addition
Public Sub fOpenFrame(uf As UserForm, strName As String)
Dim con As Control
Dim i As Long
i = 5
Application.ScreenUpdating = False
With uf.Controls(strName)
.Top = 38.15
.Left = 120
.Height = 400
.Width = 565
.Visible = True
End With
For Each con In uf.Controls
If TypeName(con) = "Frame" And con.Name <> strName And InStr(con.Name, "Menu") < 1 _
And con.Name <> "frmNewAbsenceButton" And con.Name <> "frmExistingAbsenceButton" Then
With con
.Visible = False 'Error occurs here'
.Top = 5
.Left = i
.Height = 20
.Width = 20
End With
i = i + 25
End If
Next con
Application.ScreenUpdating = True
End Sub
Edit 2 - Pictures Added
This is the first frame Frame1. A msgbox pops up and when the user clicks yes, it opens Frame2.
This is Frame2. This frame opens with all the textboxes / comboboxes disabled. The button control 'Edit' is enabled.
I'd prefer to make all frames invisible first (and not to care about their position nor size); after that the only relevant frame can be made visible.
If the sub is in the userform's macromodule you can use Me("Frame4") and refrain from the argument: 'uf as userform'.
Public Sub fOpenFrame(uf As UserForm, strName As String)
for each it in uf.controls
if typename(it)="Frame" then it.visible=false
next
With uf.Controls(strName)
.Top = 38.15
.Left = 120
.Height = 400
.Width = 565
.Visible = True
End With
End Sub
I have been having the same issue intermittently.
After reading the other answers, I added .setfocus call to a valid textbox before I the visible = false call, and it seemed to fix the issue.
With con
textbox1.setfocus 'Adding this seemed to fix the issue
.Visible = False 'Error occurs here'
.Top = 5
.Left = i
.Height = 20
.Width = 20
End With
I have tested in excel 2010 the the code is working fine(I don't have excel 2007)
Please try the below code.
Private Sub Frame1_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Me.Frame1.Visible = False
End Sub
I'm working on a Userform in Excel that has to be dynamically generated each time. It can list many (100+) lines which are all exactly the same in format. These are generated by the following code snippet.
' ctextbox
Set ctl = .Controls.Add("Forms.Textbox.1")
With ctl
.Top = 12 + linetop
.Left = 464.9
.Width = 140
.Height = 18
.Name = FieldName & "_ctextbox"
End With
' cshow
Set ctl = .Controls.Add("Forms.CommandButton.1")
With ctl
.Top = 13.1 + linetop
.Left = 611.35
.Width = 41.95
.Height = 18
.Name = FieldName & "_cshow"
.Caption = "Show All"
End With
' confirm
Set ctl = .Controls.Add("Forms.Checkbox.1")
With ctl
.Top = 13.5 + linetop
.Left = 659
.Width = 44.95
.Height = 17.25
.Name = FieldName & "_confirm"
.Caption = "Confirm"
End With
It would fine except for a random occurrence where the Confirm checkbox appears smaller than the rest. The screenshot below shows what I mean.
Has anyone experienced this issue before?
I would recommend using repainting the Userform after you have added the controls dynamically.
The Repaint method completes any pending screen updates for a specified form. When performed on a form, the Repaint method also completes any pending recalculations of the form's controls.
This method is useful if the contents or appearance of an object changes and you don't want to wait until the system automatically repaints the area. Me.Repaint simply updates the display by redrawing the form
I had the same issue in that my repaint did not work. I solved this by setting the CheckBox AutoSize property to True and I have no problems anymore.
I'm running into an unusual problem. I have an application with a multipage that contains about 10 pages and every page contains another multipage with 3-5 pages. The problem was that the app was too "heavy" and I wanted to break it into multiple forms (a form for every page).
In the initial app the form had as I said about 10 pages, with another 3-5 pages on every one of them and on every page there were about 3-20 comboboxes, 4-40 textboxes. All of them were loaded at initialization by executing a piece of code.
Now... I copied the piece of code for every page and added it in the initializations of the form that replaced it.
The code is something like this:
Private Sub UserForm_Initialize()
Dim i As Integer
Dim ws1 As Worksheet
Dim pagini As range
Set ws1 = Worksheets("Config")
Dim cControl As Control
Set cControl = Me.Controls.Add("Forms.Multipage.1", "oly", True)
With cControl
.Width = 650
.Height = 380
.Top = 0
.Left = 0
End With
Me.Controls("oly").Pages.Remove (Page1)
Me.Controls("oly").Pages.Remove (Page2)
For Each pagini In ws1.range("pagoly")
Me.Controls("oly").Pages.Add (pagini)
Next pagini
i = 0
Do While i < 5
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "iooly" & i, True)
With cControl
.Caption = "IO"
.Width = 210
.Height = 340
.Top = 2
.Left = 5
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "niooly" & i, True)
With cControl
.Caption = "nIO"
.Width = 210
.Height = 340
.Top = 2
.Left = 220
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "descriere" & i, True)
With cControl
.Caption = "Descriere"
.Width = 210
.Height = 340
.Top = 2
.Left = 435
End With
Loop
End Sub
So far it just adds the frames on every of the 5 pages of this form. The problem is that I get the "There is insufficient memory available to complete this operation" when I want to run it and I really don't know why. Yet on the previous version which loaded 50 times more stuff there was no problem. Do you have any idea where's the problem because I really don't understand it.
You have
Do While i < 5
'stuff
Loop
and I don't see where i changes value so that the program will exit the loop. Am I missing something?
The scenario is trying to adjust font size to get a nice graphic arrangement, or trying to decide where to break a caption/subtitle.
a) In XL VBA is there a way to find out whether a text on a textbox, or caption on a label, still fits the control?
b) Is there a way to know where was the text/caption broken on multiline control?
I gave this a rest, gave it enough back-of-head time (which produces far better results than "burp a non-answer ASAP, for credits"), and...
Function TextWidth(aText As String, Optional aFont As NewFont) As Single
Dim theFont As New NewFont
Dim notSeenTBox As Control
On Error Resume Next 'trap for aFont=Nothing
theFont = aFont 'try assign
If Err.Number Then 'can't use aFont because it's not instantiated/set
theFont.Name = "Tahoma"
theFont.Size = 8
theFont.Bold = False
theFont.Italic = False
End If
On Error GoTo ErrHandler
'make a TextBox, fiddle with autosize et al, retrive control width
Set notSeenTBox = UserForms(0).Controls.Add("Forms.TextBox.1", "notSeen1", False)
notSeenTBox.MultiLine = False
notSeenTBox.AutoSize = True 'the trick
notSeenTBox.Font.Name = theFont.Name
notSeenTBox.SpecialEffect = 0
notSeenTBox.Width = 0 ' otherwise we get an offset (a ""feature"" from MS)
notSeenTBox.Text = aText
TextWidth = notSeenTBox.Width
'done with it, to scrap I say
UserForms(0).Controls.Remove ("notSeen1")
Exit Function
ErrHandler:
TextWidth = -1
MsgBox "TextWidth failed: " + Err.Description
End Function
I feel I'm getting/got close to answer b), but I'll give it a second mind rest... because it works better than stating "impossible" in a flash.
I'm sure there is no way to do this with the ordinary Excel controls on the Forms toolbar, not least because (as I understand it) they are simply drawings and not full Windows controls.
The simplest approach may be to make a slightly conservative estimate of the maximum text length for each control, through a few tests, and use these to manage your line breaks.
This can be achieved by taking advantage of the label or textbox's .AutoSize feature, and looping through font sizes until you reach the one that fits best.
Public Sub ResizeTextToFit(Ctrl As MSForms.Label) 'or TextBox
Const FONT_SHRINKAGE_FACTOR As Single = 0.9 'For more accuracy, use .95 or .99
Dim OrigWidth As Single
Dim OrigHeight As Single
Dim OrigLeft As Single
Dim OrigTop As Single
With Ctrl
If .Caption = "" Then Exit Sub
.AutoSize = False
OrigWidth = .Width
OrigHeight = .Height
OrigLeft = .Left
OrigTop = .Top
Do
.AutoSize = True
If .Width <= OrigWidth And .Height <= OrigHeight Then
Exit Do 'The font is small enough now
.Font.Size = .Font.Size * FONT_SHRINKAGE_FACTOR
.AutoSize = False
Loop
.AutoSize = False
.Width = OrigWidth
.Height = OrigHeight
.Left = OrigLeft
.Top = OrigTop
End With
End Sub