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.
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'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."
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 am working on a userform trying to loop through the controls in a multipage.
The user form has 2 Multipages (MultiPage1 and MultiPage2).
Multipage2 is contained within the Multipage1.
When only MultiPage1 exists I could ran the following code:
For Each pPage In frmValidationTest.MultiPage1.Pages
But after creating this nested system, and I trying to run it again, displays the following error:
"Type Mismatch" (in the For Each pPage line)
The variable pPages is declared as follows:
Dim pPage as Page
I've ran Debug.Print Mode to check misspelling issues but everything is OK ("frmValidationTest.MultiPage1.Pages.Name" does actually print out an output)
When I take a look at the pPages, it declares that the variable is Nothing.
I just realized that when declaring the variable, I have 2 classes with the same name "Page".
Not sure what's going on, is that normal? I don't think I should have 2 different classes for the same superclass. (-F2- Ref Lib only shows 1).
After closing, restarting, etc. The issue still there.
Hopefully is just a minor thing!
Many thanks in advance.
There is a Page class in both the Excel and MSForms libraries. So you will be better off using the library names in your declarations. For example, if your form looks like this:
Then this code should work:
Option Explicit
Private Sub CommandButton1_Click()
' declare variables using specific libraries
Dim mpgItem1 As MSForms.MultiPage
Dim mpgItem2 As MSForms.MultiPage
Dim pagItem1 As MSForms.Page
Dim pagItem2 As MSForms.Page
' other variables
Dim ctlItem As Control
Dim intCounter1 As Integer
Dim intCounter2 As Integer
Dim intPageCount1 As Integer
Dim intPageCount2 As Integer
Set mpgItem1 = UserForm1.MultiPage1
' get page count of first multi page
intPageCount1 = mpgItem1.Pages.Count
' not using for..each loop ...
For intCounter1 = 0 To intPageCount1 - 1
Set pagItem1 = mpgItem1.Pages(intCounter1)
MsgBox pagItem1.Name
For Each ctlItem In pagItem1.Controls
' looking for nested multi page
If TypeName(ctlItem) = "MultiPage" Then
' same code as for first multipage
Set mpgItem2 = ctlItem
intPageCount2 = mpgItem2.Pages.Count
For intCounter2 = 0 To intPageCount2 - 1
Set pagItem2 = mpgItem2.Pages(intCounter2)
MsgBox pagItem2.Name
Next intCounter2
End If
Next ctlItem
Next intCounter1
End Sub
I am an intern and learning LotusNotes currently, so am not very fluent with it yet.
My question is, how can I program an action button to add a row to an existing table in LotusNotes 8.5?
I have tried the following code, but it has not worked for me,
Sub Click(Source As Button)
Dim uiw As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = uiw.CurrentDocument
Dim doc As NotesDocument
Set doc = uidoc.Document
Dim Body As NotesRichTextItem
Set body = doc.GetFirstItem("Body")
If body Is Nothing Then
Msgbox "Click on the Reset the demo action to create the table first."
End If
Dim rows As Integer, rownumber As Integer, numrowstoadd As Integer
Dim strrownumber As String, strrowstoadd As String
Dim rtnav As NotesRichTextNavigator
Set rtnav = body.CreateNavigator
Dim rttable As NotesRichTextTable
Set rttable = rtnav.GetFirstElement(RTELEM_TYPE_TABLE)
If rttable Is Nothing Then
Msgbox "No table created - use the Reset the demo action first."
Else
rows=rttable.RowCount
strrowstoadd = Inputbox("Enter the number of rows to add.")
If Isnumeric( strrowstoadd ) Then
numrowstoAdd = Cint(strrowstoAdd)
If numrowstoAdd <= 0 Then
Msgbox "Enter a number greater than zero."
Exit Sub
End If
Else
Msgbox ("Enter a integer number only.")
Exit Sub
End If
strrownumber = Inputbox("Enter the number corresponding to the row to start adding at, no greater than " & rows & ".")
If Isnumeric( strrownumber ) Then
rownumber = Cint(strrownumber)
If rownumber < 0 Or rownumber > rows Then
Msgbox ("You entered too high a number or a number less than zero, try again.")
Exit Sub
End If
Else
Msgbox ("Enter a integer number only.")
Exit Sub
End If
Call rttable.AddRow(numrowstoadd, rownumber)
End If
doc.save True, True
uidoc.Close
Call uiw.EditDocument(False,doc)
End Sub
Any help would be great. Thanks!
Without taking a detailed look at your code, I believe the fundamental problem you are facing is most likely the fact that the NotesRichText class is part of what we call the "back end classes" for Notes. That means that it is one of the objects that represents the in-memory version of data from an NSF file in its storage format, and this is not the same as the "front end classes". Those are objects that represent the data that the user sees and edits. You can tell the front end from back end classes by the prefix NotesUI for all the front end classes.
The thing is, the objects in the front end classes and back end are kept synchronized except for rich text, and what that means is that changes that you make to NotesRichText objects do occur in memory, and the are saved to the NSF file if you call NotesDocument.save(), but they are not reflected in what you see on the screen until you do something to reload the front end data from the back end. Here's a link to a wiki page that demonstrates a technique for doing that.
You wrote "but it has not worked for me". I tried your code and it works. I suggest you just few changes in order to make it work better:
close the doc before working with the table in the RT (back end) just before Dim Body As NotesRichTextItem
uidoc.save 'to save any change done
doc.saveoptions = "0"'to avoid do you want to save
uidoc.Close True
in place of the 3 last lines:
doc.Save True, True
Call uiw.EditDocument(True,doc)
NB you have to add Exit Sub after "Click on the Reset the demo action to create the table first" and after "No table created"