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
Related
I'm trying to learn how to use a progress bar with a userform.
The problem I have, with my code, is that it displays the progress bar after running the loop; it should be running the loop while showing the progress bar instead like 10%...20%...30%...40%......100%.
Can anyone help me fix my code to achieve this?
'-----Below is loop-----------------------------------------------------
Sub looprange()
Dim r As Range
'----------loop thru 0 to 9 ---------------
For Each r In Sheet6.Range("j2", Range("j" & Rows.Count).End(xlUp))
Sheet6.Range("i2").Value = r.Value
ActiveWindow.ScrollRow = 11
Application.CutCopyMode = False
Call print_jpeg
Next r
MsgBox "done"
End Sub
--
'--------Below is vba code in userform :------------
Private Sub UserForm_Activate()
Dim remainder As Long
Dim i As Long, j As Long
Call looprange
remainder = 0
For i = 1 To 200
UserForm1.Label2.Width = UserForm1.Label2.Width + 1
If i Mod 2 = 0 Then
remainder = remainder + 1
UserForm1.Caption = remainder & ” % complete”
UserForm1.Label2.Caption = remainder & “%”
End If
For j = 1 To 600
DoEvents
Next j
Next i
MsgBox “Loading of program complete.”
Unload UserForm1
End Sub
I believe a true status bar is not included in standard VBA (without references), however you can abuse a label control. Be aware that this method trades performance for user clarity (the user can see that the application is working, but it is slower than the same application without the status bar)
Simply add three labels, one for status text, one for the actual moving bar and one for full bar border. And format them to fit your application (see image below):
Code below:
Private Sub cbStart_Click()
one_percent_bar_width = lLoadBar.Width / 100 'width of one percent of the total loading bar
max_numbers = 1000 'only for demo purpose
Me.lLoadingBar.Visible = True
For i = 0 To max_numbers 'your loop here
'your code here
percentage = i / max_numbers * 100 'calculation of progress, replace i and max_numbers to fit your loop
Me.lStatus.Caption = percentage & "% complete" 'status percentage text
Me.lLoadingBar.Width = percentage * one_percent_bar_width 'width of actual blue bar
DoEvents 'slows down code but only way to make the bar visibly move, tradeoff between user clarity and speed
Next i 'edit to fit your loop
Me.lStatus.Caption = "Complete!" 'adjust status to whatever you want
End Sub
Private Sub UserForm_Initialize()
Me.lLoadingBar.Visible = False 'hide the small blue bar
Me.lStatus.Caption = "Progress not started" 'adjust status to whatever you want
End Sub
There are a few issues with your code, but to focus on the Progress Bar part, I'll share an example of one way to handle a progress bar in Excel (using the built-in status bar).
Instead of actually doing anything useful, this example is pausing for a split second between loops, but reports the status on the status bar.) Hopefully it will give you some ideas.
Sub ProgressBarTest()
Const LoopsToRun = 500
Dim z As Integer
For z = 1 To LoopsToRun
'put a random number in A1
Range("A1") = Int(Rnd() * 100) + 1
'update status bar
Application.StatusBar = "Progress: " & Format((z / LoopsToRun), "0.0%")
'pause for .3 seconds (instead of pausing, you'd run your actual procedure here)
Pause (0.1)
Next z
Application.StatusBar = "Complete!"
End Sub
Sub Pause(sec As Single)
'pauses for [sec] second
Dim startTime As Single
startTime = Timer
Do While Timer < startTime + sec
DoEvents
Loop
End Sub
More info here and here.
VBA has a progress bar control that can be added to forms. While you are learning, you can simply add this control to the form and then update that control during the loop where you are doing the useful form functions. The progress bar controls includes useful properties such as min and max.
If you are doing multiple things in your form, you can update a label to tell the user what is progressing as well as the amount of progress.
[More advanced] In some of my previous work, I have set up VBA routines to run in the background and created a progress bar form using events. This allows for a more sophisticated view with progress statements as well as a percentage run. But the basis of this form is still the progress bar control. While using events is more complicated it allowed me to make a more general progress bar form that can be used by any of my vba functions and these functions are then unaffected by any changes I make to the form because the events act as a kind of standard interface.
Update from a comment by #MathieuGuindon: "The control is actually a VB6 control and will only work in a 32-bit VBA host with the .OCX properly registered, which is getting more and more challenging to do with the more recent Windows versions; referencing and using these controls in VBA7 is heavily discouraged."
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
I dynamically create a userform named UserForm1. In it, I generate textboxes, which will be filled manually by a user. Afterwards I would like to read their value but I don't know how to call the (value of the) textbox.
The following bit of code is used to create and name the textboxes:
With UserForm1 'scaling userform
.Height = max_width
.Width = 600
End With
For test1 = 1 To nr_of_zeros + 1 'create textboxes
Set ctextbox = Controls.Add("forms.textbox.1", test1) 'creating textbox
With ctextbox 'scaling textbox
.Height = 20
.Width = 40
.Top = 40 + 25 * test1
.Left = 400
End With
So the textbox will have the name of the number (integer or long?) of test1.
I tried the following sentences to try to read the value of the textbox into: absorb_text but unsuccesfull so far. Does anybody know the correct complete way to call the above created textbox?
'ctextbox.name = Controls.Add("forms.textbox.1", test1) 'creating textbox
'absorb_text = forms("textbox").Controls(test1).Value
'absorb_text = forms.("UserForm1").textbox.(test1).value
forms.textbox.1.(test1)
strname = TextBox1(test1).Text
(Analog to, one does not call cell "A2" by)
.range("A2")
but with
Thisworkbook.worksheets("sheetname").range("A2").text
Thisworkbook.worksheets("sheetname").range("A2").value
Thisworkbook.worksheets("sheetname").cells(2,1).text
Thisworkbook.worksheets("sheetname").cells(2,1).value
Thank you very much! I was still wondering why/what the 1 does in "forms.textbox.1" I copied it because it worked, but am confused by its function.
Also in light of your discussion below: I believe, technically the code does not look for a control name that is equal to the/a number 1 but to a string character which happens to equal the character 1. hence it is not equal to a number but a character.
*argument against that is that it still works with: `If ctrl.Name = 1 Then' in which case I would think the 1 is treated as a number.
When you created your TextBoxes in your code line:
Set ctextbox = Controls.Add("forms.textbox.1", test1) the names of your Textboxes is 1, 2, 3, etc.
In order to read your TextBoxes (created at run-time) I loop through all Controls of the User_Form, check if it's type TextBox, and check the Name property of the Control.
Code
Option Explicit
Private Sub ReadRunTimeTextBox()
Dim ctrl As Control
Dim absorb_text As String
' loop through all control in user form
For Each ctrl In Me.Controls
' check if control is type TextBox
If TypeName(ctrl) = "TextBox" Then
' if control name is 1 (first created TextBox in your array)
If ctrl.Name = "1" Then
absorb_text = ctrl.Text
' the message box is for debug only
MsgBox absorb_text
End If
End If
Next ctrl
End Sub
Here are two more ways to refer to the dynamically added control
Const nr_of_zeros = 4
For test1 = 1 To nr_of_zeros + 1 'create textboxes
Debug.Print Controls(test1)
Next
Debug.Print Me![1]
Debug.Print Me![2]
Debug.Print Me![3]
Debug.Print Me![4]
I have a listbox in a Diagram, when calling the function "drawDiagram" I want to get the selected Items of the listbox. Here is my code to do that:
Function DrawDiagram()
Dim x As Integer
Dim diaLst As ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 0 To diaLst.ListCount - 1
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
diaLst.ListCount correctly returns the number of Items in the list. But diaLst.Selected(x) does not work at all.
The Error message is:
German: "Die Selected-Eigenschaft des ListBox-Objektes kann nicht zugeordent werden"
English: "The Selected Property of the ListBox Object cannot be assigned" (or similar)
Does anyone know, what I did wrong?
thanks
natasia
By the way, this is the code I used to generate the list box in a chart sheet, in a separate function. At the moment when a button is clicked, the DrawDiagram function is called. The aim of the "DrawDiagram" function is to plot the selected items of the listbox in the diagram.
Set diaLst = ActiveSheet.ListBoxes.Add(ActiveChart.ChartArea.Width - 110, 5, 105, 150)
With diaLst
.Name = "DiaList"
.PrintObject = False
.MultiSelect = xlSimple
i = 2
While wTD.Cells(rowVarNames, i) <> ""
.AddItem wTD.Cells(rowVarNames, i)
i = i + 1
Wend
.Selected(3) = True
End With
first off, you must be dealing with a "Form" control (not an "ActiveX" one) otherwise you couldn't get it via .ListBoxes property of Worksheet class
I tested it in my environment (W7-Pro and Excel 2013) and found that (quite strangely to me) the Selected() property array is 1-based.
This remained even with Option Base 0 at the beginning of the module
Make sure Microsoft Forms 2.0 Object Library reference is added to your project
Function DrawDiagram()
Dim x As Long
Dim diaLst As MSForms.ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 1 To diaLst.ListCount
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
use Sheets("Sheet1").Shapes("List Box 1").OLEFormat.Object instead
I stumbled upon the same problem. The solution turned out to be simple, just had to tweak the code a litte bit and play around with the ListBox properites:
Function GetSelectedRowsFromListBox(lstbox As ListBox) As Collection
Create the collection
Dim coll As New Collection
Dim lst_cnt As Variant
lst_cnt = lstbox.ListCount
Dim arr_selectedVal As Variant
arr_selectedVal = lstbox.Selected
' Read through each item in the listbox
Dim i As Long
For i = 1 To lstbox.ListCount
' Check if item at position i is selected
If arr_selectedVal(i) Then
coll.Add i
End If
Next i
Set GetSelectedRowsFromListBox = coll
End Function
.Selected property returns a 1-based array with True/False values coresponding to rows in your multiple choice Form Control ListBox.
From that you can get the list of each value.
This solution is an expanded version of what is mentioned here, however this also complies with Form Control ListBox, no just ActiveX ListBox (which are 2 same but different things ;) ):
https://excelmacromastery.com/vba-listbox/
Hope that helps in the future!
I'm trying to update my userform Updating (which is essentially a progress bar).
It doesn't update the first time the userform is called and the second time it only updates the label description and not the width of the bar.
Sub UpdateUpdatingUF(filenum As Integer, filecount As Integer)
Dim filenumdbl As Double
Dim filecountdbl As Double
Dim boxwidth As Integer
Dim barwidth As Integer
Dim boxwidthdbl As Double
filenumdbl = CDbl(filenum)
filecountdbl = CDbl(filecount)
boxwidthdbl = CDbl(boxwidth)
boxwidth = 300
barwidth = CInt(boxwidthdbl * filenumdbl / filecountdbl)
With Updating
.Label3.Caption = "Running file: " & CStr(filenum) & " / " & CStr(filecount)
.ProgressBar.Width = barwidth
End With
End Sub
I'm probably declaring too many variables but I am trying to make sure that that isn't the cause.
I'm testing with the procedure below.
Sub TestUpdate()
Updating.Show
Call UpdateUpdatingUF(3, 7)
DoEvents
Updating.Repaint
End Sub
Replace
Updating.Show
with
Updating.Show vbModeless
Too late but:
boxwidthdbl = CDbl(boxwidth)
boxwidth = 300
those two lines should be in the reverse order :
boxwidth = 300
boxwidthdbl = CDbl(boxwidth)
as you are using a variable that has not been initialised.
The proposed solution is correct if you want to update during another operation (inside a do/while or a for/next loop for instance). vbModeless instructs the program not to wait for the form to be closed. Updating while the form is displayed is made thanks to that and the DoEvents instruction.
If the update is only required once, you should also reverse the updating of the values and the display of the form:
Call UpdateUpdatingUF(3, 7)
Updating.Show
--> this is why you had to test twice to see the results (you displayed the form before updating the values and had to close it to update the values).
Like this, no more need for doevents and repaint.
To be sure to unload the form, if needed for tests purpose, useUnload Updating.