I'm trying to code a dynamic/conditional userform that changes the controls on the userform based on what is entered into certain input fields of the userform. The whole idea of my VBA Excel project is to take 2 data series (say, x and y) and manipulate them according to functionalities queried by the user. The specific part of my userform that causes the problem is that part where the user can choose which type of the series he/she wants to pick for either variable (x or y).
For you to understand my issue as quickly as possible, I uploaded an excel file to the following link:
http://www26.zippyshare.com/v/51719800/file.html
To keep things simple, I isolated the problem causing code, cut out all other macros and limited the userform to the controls that cause the error. To run it, click on the "Initialize" button located in the top left corner of the first tab.
When initialized, the userform contains 6 controls: 2 labels, 2 comboboxes, and 2 frames. The functionality of the uploaded test file is limited: For both series (independent series (or x) and dependent series (y)) when you click on "Replacement" a number of controls should be added to the frame corresponding to the series.
The weird thing is that this works without a problem for the first(/independent) series, but for the second(/dependent) series I get
Run-time-error '-2147417848(80010108): Automation error. The object
invoked has disconnected from its clients.
even though both instances call the very same procedure and in both instances the arguments passed to the function are valid. I tried the code on coworkers' laptops as well, but get the same error.
The code of the procedure that causes the error is given below. The procedure simply adds a control to a certain target frame based on arguments passed to the function. The exact line causing the crash is:
Set daFrame = dest.Controls.Add("Forms.Frame.1", name)
What is also weird is that the error only occurs for the case where we are creating a frame. Adding all the other controls e.g. ListBoxes, Labels, etc. (even for the second series) is not a problem.
Public Sub add_control(dest As MSForms.Frame, ht As Integer, wdt As Integer, tp As Integer, lft As Integer, typ As String, _
name As String, Optional capt As String)
Dim daFrame As MSForms.Frame
Dim daButton As MSForms.OptionButton
Dim daList As MSForms.ListBox
Dim daLabel As MSForms.Label
Dim daBox As MSForms.ComboBox
Select Case typ
Case "Frame"
Set daFrame = dest.Controls.Add("Forms.Frame.1", name)
With daFrame
.Height = ht
.Width = wdt
.Top = tp
.Left = lft
.Caption = capt
End With
Case "ListBox"
Set daList = dest.Controls.Add("Forms.Listbox.1", name)
With daList
.Height = ht
.Width = wdt
.Top = tp
.Left = lft
End With
Case "OptionButton"
Set daButton = dest.Controls.Add("Forms.OptionButton.1", name)
With daButton
.Height = ht
.Width = wdt
.Top = tp
.Left = lft
.Caption = capt
End With
Case "Label"
Set daLabel = dest.Controls.Add("Forms.Label.1", name)
With daLabel
.Height = ht
.Width = wdt
.Top = tp
.Left = lft
.Caption = capt
End With
Case "ComboBox"
Set daBox = dest.Controls.Add("Forms.ComboBox.1", name)
With daBox
.Height = ht
.Width = wdt
.Top = tp
.Left = lft
End With
End Select
End Sub
Please help me guys, I really appreciate any input. Also, if there is a way/programming style to guard against such weird behavior/erros, please let me know. Of course, I searched this forum and google for any hints, but it seems that this problem is rather code specific. In any case, I couldn't find anything helpful on the web.
Cheers
I haven't really figured out what is the real cause, but it is not the code - the real issue must be in the DepFrame. If you simply delete it and copy&rename IndFrame all works fine. But you probably figured out that already - I also wanted to tell you that you have a mistake in Dependent_change sub. You are using value of Independent instead of Dependent in the last ElseIf.
Private Sub Dependent_Change()
If Dependent.Value = "Replacement" Then
DepFrame.Caption = "Replacement"
Call rearrange_frame("Replacement2")
ElseIf Dependent.Value = "Futures" Then
DepFrame.Caption = "Futures"
Call rearrange_frame("Futures2")
here: ElseIf Independent.Value = "Spread" Then
DepFrame.Caption = "Spread"
src = 2
End If
End Sub
Related
In my program a string gets created and its size varies a lot.
This string should then be shown in a separate window.
Unfortunately the regular Msgbox (limited to 1024 signs I believe) is too small for my needs.
Now I created a Userform for the issue but of course it looks silly when there is a giant Userform and only two values inside, but next time I need the size since there are 1000 values in the string.
I noticed that the regular Msgbox changes size depending on how long the string inside it is.
How can I create a userform that changes its size depending on its content?
I only found information on how to make it full screen, which isn't helpful for this case.
The only real code that I can show you is something generic like this:
Sub Ausgabe1()
Dim Werte As Variant
Dim x As Integer
For i = 0 to X
Werte(i) = i
Next i
MsgBox Werte
End Sub
You can vary the value of the width property. How I would do it is to create the userform with a text box and give the userform a displaytext property.
Property Let DisplayText(s as String)
Dim x as Long
x = Len(s)
If x > 0 Then
Me.Textbox1.Width = x*.7
Me.Width = Me.Width * 100/x
Else
Me.Textbox1.Width = 75 ' (edited)
Me.Width = 100
End If
End Property
And then I'd call it like this
Load Userform1
With Userform1
.DisplayText = "your message here"
.Show
End With
You'll have to play with the numbers in the code to get them to fit your screen resolution etcx
I've an excel vba form named as 'UserForm'. Overall, there's a button (name as 'buttonAdd') that the function could create/add textbox based on inputed (from 'a' variabel) value dynamically. Here's the code.
Public Sub buttonAdd_Click()
Dim a As Integer
a = TextBox1.Value
Dim cCntrl As Control
For i = 1 To a
Set cCntrl = Me.Controls.Add("Forms.TextBox.1", "quarter", True)
With cCntrl
.Name = "quarter" & d
.Width = 150
.Height = 25
.Top = 100 + (d * 25)
.Left = 220
.ZOrder (0)
End With
Next i
Now, I've a problem. I can't take/get the value from those dynamic textbox. I tried using this code for saving the value into 'A1' cell, but it's doesnt work.
Private Sub SaveButton_Click()
Dim a As Integer
Dim Ws As Worksheet
Dim cCntrl As Control
Set Ws = Worksheets("Sheet1")
Ws.Range("A1").Value = quarter1.Value
End Sub
I thought the name of first dynamic textbox is quarter1, but when I tried to get the value, it didn't work. Is there anyway or hint for solving this issue. Just saying: just take the value of the first text box, write it there, then take another one and so on.
Thanks a lot.
Looks like your problem is a simple typo. You have used d instead of i (d is undefined in your code). I recommend always using Option Explicit.
Public Sub buttonAdd_Click()
Dim a As Long ' Minor, but Integer I sjust too short these days for a lot of things.
Dim i as Long
a = TextBox1.Value
Dim cCntrl As Control
For i = 1 To a
Set cCntrl = Me.Controls.Add("Forms.TextBox.1", "quarter", True)
With cCntrl
.Name = "quarter" & CStr(i) ' explicit rather than implicit conversion
.Width = 150
.Height = 25
.Top = 100 + (i * 25)
.Left = 220
.ZOrder (0)
End With
Next I
Edit: Might be a couple more typos in the .Add command (e.g. you might have wanted "quarter" & "1" instead of just "quarter"?) but I don't have the VBA reference up at the moment to check.
I have macro assigned to a rectangle shape that goes to the next sheet in my workbook.
I'm trying to add a press down and up effect to this rectangle.
When I use this code, the rectangle is only pressed down then then the next sheet is activated, and if I returned back to the previous sheet, the rectangle is released.
Wht I need is that the rectangle is pressed down and then released before going to the next sheet.
Dim MyButton As Shape
Dim oHeight, oWidth, cHeight, cWidth As Double
Dim oTop, oLeft As Long
Public Sub PressButton()
Set MyButton = ActiveSheet.Shapes(Application.Caller)
With MyButton
'Record original button properties.
oHeight = .Height
oWidth = .Width
oTop = .Top
oLeft = .Left
'Button Down (Simulate button click).
.ScaleHeight 0.9, msoFalse
.ScaleWidth 0.9, msoFalse
cHeight = .Height
cWidth = .Width
.Top = oTop + ((oHeight - cHeight) / 2)
.Left = oLeft + ((oWidth - cWidth) / 2)
End With
'Set MyButton variable to Nothing to free memory.
Set MyButton = Nothing
End Sub
Public Sub ReleaseButton()
Set MyButton = ActiveSheet.Shapes(Application.Caller)
With MyButton
'Button Up (Set back to original button properties).
.Height = oHeight
.Width = oWidth
.Top = oTop
.Left = oLeft
End With
'Set MyButton variable to Nothing to free memory.
Set MyButton = Nothing
End Sub
Public Sub NextPage()
PressButton
Application.Wait (Now + TimeSerial(0, 0, 1))
ReleaseButton
Dim ws As Worksheet
Set ws = ActiveSheet
Do While Not ws.Next.Visible = xlSheetVisible
Set ws = ws.Next
Loop
With ws.Next
.Activate
.Range("A1").Select
End With
End Sub
You're better off using a 'Command Button': shapes and rectangle objects don't really support the event-driven 'On Click' functionality you need here: calling an associated macro is pretty much all that they do.
However, you may well be stuck with that shape as your interface (support for ActiveX command buttons is very poor in 64-bit environments), so here goes...
Background: how to make a button look like a button:
Most shapes have a 'Shadow' property, and an outside shadow cast by a light source from a 45-degree angle (from the top-left corner) gives a 'raised' effect. Conversely, an inside shadow cast from the opposite angle (from a light source off the bottom-right corner) gives a 'sunken' effect.
In practice, an inside shadow for both is good enough: just change the angle.
In VBA, the 'angle' of the light source for your shape's shadow is given as X and Y offsets, and 45 degrees corresponds to 1.14142:
Dim oShape As Excel.Shape
Dim oShadow As Excel.ShadowFormat
Set oShape = ActiveSheet.Shapes(i)
Set oShadow = oShape.Shadow
' Shadow cast by light from above-right at 45 degrees for a 'raised' effect:
oShadow.OffsetX = Sqr(2)
oShadow.OffsetY = Sqr(2)
' Shadow cast by light from above-right at minus 45 degrees for a 'sunken' effect:
oShadow.OffsetX = -Sqr(2)
oShadow.OffsetY = -Sqr(2)
...And that's the code for your click 'up' and click 'down' button state.
I Strongly recommend that you use the built-in dialogs to set the shape's fill colour and the shadow's size, transparency and blur. For your reference, the settings I use for a smart 'semi-flat' light grey button are listed below - but I do not recommend that you set them in VBA code, as these formats will not be applied in the order you expect, and the button will not look like the 'clean' shape you can build using the UI dialogs:
' Light-grey button with a slightly darker 'softened' border
oShape.Fill.ForeColor.RGB = &HD8D8D8
oShape.Line.ForeColor.RGB = &HC0C0C0
oShape.Line.Weight = 2
oShape.Line.Transparency = 0.75
' Use the shape's shadow to give a 'raised button' effect:
oShadow.Style = msoShadowStyleInnerShadow
oShadow.Visible = True
oShadow.Blur = 2
oShadow.Size = 100
oShadow.Transparency = 0.5
' Shadow cast by light from above-right at 45 degrees for a 'raised' effect:
oShadow.OffsetX = Sqr(2)
oShadow.OffsetY = Sqr(2)
You can also use the 3-D effects dialog, but this works by a 'chisel' effect for most shapes (including your rectangle): I haven't found any predefined 'raised' or 'sunken' three-D styles for shapes.
Major Edit:
Guess who's looking at the job of replacing all the Active-X control buttons on all the tactical spreadsheet tools before the 64-Bit Office rollout renders them inoperable?
So your question just became very, very interesting indeed. Here's what I'm doing about that:
Generic 'Button Click' code for using Excel 'Shape' objects to call a VBA Macro instead of ActiveX controls.
This is what I'm using instead of ActiveX buttons: text labels, rectangles and images, placed into the worksheet using the 'Insert' menu on the Ribbon.
These objects are all Excel 'Shapes', they can all be associated with a named macro, and they have a common 'shadow' effect that serves as a 'raised button' 3D effect.
The example below is a function call from an image (it's a 32*32 icon for a database, with a question mark) embedded as a shape on a worksheet. I gave this ersatz control button a meaningful name, and I named the macro [Name]_Click(), because I'm replacing the existing 'Click' event procedures.
So this macro is a public subroutine on a worksheet identified with a code name, - users can 'rename' the sheet, changing the user-readable label, but they won't rename the underlying VBA class module - and it's visible as MySheetCodeName.img_TestDefaultDSN_Click() in the 'assign macro' list when you right-click the shape.
..That's why it's Public (not Private, as the automatically-created event procedure stubs for ActiveX controls will be): private subs aren't visible in the 'Assign Macro' list.
Public Sub img_TestDefaultDSN_Click()
ClickDown Me.Shapes("img_TestDefaultDB")
ShowDBStatus "EOD_Reports_DSN"
ClickUp Me.Shapes("img_TestDefaultDB")
End Sub
This calls a pair of generic 'Click Down' and 'Click Up' subroutines, in a regular code module:
Public Function ClickDown(objShape As Excel.Shape)
On Error Resume Next
'Recast the button shadow from bottom-right to top-left:
With objShape.Shadow
.Visible = msoFalse
.OffsetX = -1.2
.OffsetY = -1.2
.Visible = msoTrue
.Blur = 1
.Size = 99
.Transparency = 0.75
.Style = msoShadowStyleInnerShadow
.Obscured = msoFalse
End With
'Darken the button face slightly:
If objShape.Type = msoPicture Then
With objShape.PictureFormat
.Brightness = .Brightness - 0.01
End With
Else
With objShape.Fill
.Visible = msoTrue
.ForeColor.Brightness = .ForeColor.Brightness - 0.01
End With
End If
End Function
Public Function ClickUp(objShape As Excel.Shape)
On Error Resume Next
'Restore the button face to it's default brightness:
With objShape.Shadow
.Visible = msoFalse
.OffsetX = 1.2
.OffsetY = 1.2
.Visible = msoTrue
.Blur = 1
.Size = 99
.Transparency = 0.75
.Style = msoShadowStyleInnerShadow
.Obscured = msoFalse
End With
'Restore the button shadow to bottom-right:
If objShape.Type = msoPicture Then
With objShape.PictureFormat
.Brightness = .Brightness + 0.01
End With
Else
With objShape.Fill
.Visible = msoTrue
.ForeColor.Brightness = .ForeColor.Brightness + 0.01
End With
End If
End Function
You may well have your own preferences for the appearance of a 'control button', but this works for me.
Note that the 'Click Down' effect is never seen if 'Click Up' follows immediately: nor even if a 'Sleep' or an 'Application Wait' statement separates them - you'll only see it if there's real code with a user-detectable elapsed time or a modal dialog.
Is it possible to use Private subs. You only need to change the way you call the subroutines. To call private sub, even located in another code module, you have to use:
Application.Run "[ModuleName.]MacroName"[, arg1] [,arg2...],
Everything is in details explained here:
https://wellsr.com/vba/2015/excel/3-ways-to-call-a-private-sub-from-another-module/
I am trying to create labels in a Frame during runtime with VBA. The problem is, I want to be able to click them once they are created. So this is what I made : (my labels are attached to a Frame)
Set TheLabel = Frame.Controls.Add("Forms.Label.1", Visible = True)
With TheLabel
.Name = "Label" & i
.Caption = gTab(i, 2) & "_ " & gTab(i, 0) & Temp
.Left = 6 + gTab(i, 2) * 12
.Top = 12 + 16 * i
.Height = 12
.Width = 200
End With
Where i is an integer (it's the number of the current label).
With this code, I imagine the name of my Label is now Label1, Label2 etc.
But even with this piece of code:
Private Sub Label1_Click()
Frame.Height = 200
End Sub
It doesn't seem to work.
Thanks a lot!
To add controls to a userform at runtime, with code behind the controls, see this answer and this one as well.
I want to dynamically add a radio button on a form, using VBA.
I tried writing this code, but it crashes with 'Type Mismatch'
Dim optionBtn As OptionButton
Set optionBtn = UserForm1.Controls.Add("Forms.OptionButton.1", "name", True)
optionBtn.Left = 10
optionBtn.Top = 10
optionBtn.Width = 30
optionBtn.Group = "q1"
I also tried doing this:
Dim optionBtn As Control
Set optionBtn = UserForm1.Controls.Add("Forms.OptionButton.1", "name", True)
optionBtn.Left = 10
optionBtn.Top = 10
optionBtn.Width = 30
optionBtn.Group = "q1"
but I get a Control, not a OptionButton - how can I cast it to a OptionButton ? (sorry, I'm new to VB)
I was able to get it work with this (Excel 2003):
Dim lbl As Variant
Set lbl = UserForm1.Controls.Add("Forms.Label.1", "lblFoo", True)
lbl.Caption = "bar"
Update to reflect your change from a Label to an OptionButton
Again, the key is use a Variant type for the variable that you are assigning the returned control to:
Dim opt As Variant
Set opt = UserForm1.Controls.Add("Forms.OptionButton.1", "radioFoo", True)
opt.Caption = "Bar"
Keep in mind that autocomplete won't work on the variables that are defined as Variants. However you can still refer to properties and methods of those variables by typing them manually.
Actually, I believe your problem lies in the fact that you are naming optionBtn as an object button. It needs to be named as a MSForms Option Button. Since a Variant can be an object, it will work when using a variant.
I used the following and it works fine.
Dim TempForm As Object
Dim newOptionButton as MSForms.OptionButton
Dim sUserformName as string
Dim i as integer
Dim x as integer
Dim y as integer
' other junk removed for example sake...
sUserformName = sheet1.cells(1,1)
' create form
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
With TempForm
.Properties("Caption") = sUserformName
.Properties("Width") = 450
.Properties("Height") = 300
End With
for i = 3 to sheet1.range("A65536").End(XlUp).Row
sDefault = sheet1.cells(i,5)
iGN = sheet1.cells(i,6)
' additional code removed... for sake of example... the code would add labels, text boxes, etc...
Set newOptionButton = TempForm.designer.Controls.Add("Forms.optionbutton.1")
With newOptionButton
.Caption = sDefault
.GroupName = "Group" & iGN
.Top = 20 + (20 * x)
.Left = y
.Height = 16
.Font.Size = 8
.Font.Name = "Ariel"
End With
' here the code changes x and y depending on where the user (excel template) directs the next control.
next i
Good luck....
mark's code should work, but I often prefer to create the item manually then show/hide it based on the need.
You need to define the object as an optionbutton from the msforms library.
Dim optionBtn As MSForms.OptionButton
Set optionBtn = UserForm1.Controls.Add("Forms.OptionButton.1", "name", True)