Excel VBA Progress bar on a userform

  • Thread starter Thread starter Bo_
  • Start date Start date
B

Bo_

Is it possible to implement a progress bar on a userform in Excel?

I don't find any info about progress bars in the Help or Manuals
 
Hi Bo_,
a possibility with API:
In UserForm module:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CreateWindowEX Lib "user32" _
Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String, _
ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hWndParent As Long, ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Sub CommandButton1_Click()
Me.CommandButton1.Enabled = False
Me.Repaint
Dim y&, W&, mehWnd&, pbhWnd&, i&
mehWnd = FindWindow(vbNullString, Me.Caption)
W = Me.InsideWidth * 4 / 3
y = (Me.InsideHeight - 15) * 4 / 3
pbhWnd = CreateWindowEX(0, "msctls_progress32", "" _
, &H50000000, 0, y, W, 20, mehWnd, 0&, 0, 0&)
SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 125, 0)
For i = 1 To 50000
DoEvents
SendMessage pbhWnd, &H402, CInt(100 * i / 50000), 0
Next i
DestroyWindow pbhWnd
Me.CommandButton1.Enabled = True
End Sub

Regards,
MP
 
Microsoft's web site is particularly unhelpful regarding an Excel ProgressBar.

In Excel 2003 (and likely above), a ProgressBar control can be added (to the VBA Toolbox window) from the Visual Basic window (opened using Alt-F11 from a spreadsheet) by selecting Tools -> Additional Controls ..., choosing "Microsoft ProgressBar Control, version 6.0" from the list in the Additional Controls window, making sure there is an X in the select box, then clicking OK.
 
Here is some VBA code to drive a UserForm which contains only a ProgressBar and a Label:

'Build message window to keep user informed of progress
Load UserForm
UserForm.Show vbModeless 'Open form modeless (ShowModal property is False), otherwise Excel stops when UserForm opens
With UserForm
.Label.Caption = "Loading ..."
.ProgressBar.Value = 0
.ProgressBar.Max = UBound(NewSheets)
.Repaint
End With

'Load .CSV files
For i = 0 To UBound(NewSheets)
'Keep user informed of progress
UserForm.Label.Caption = "Loading " & NewSheets(i) & ".csv ..."
UserForm.ProgressBar.Value = i
UserForm.Repaint
'If worksheet input source is a .CSV file, then load the worksheet
If InputSource(i) = "CSV" Then
Set wsTemp = wbNew.Worksheets(NewSheets(i)) 'Save pointer to place holder worksheet in workbook being built
wsTemp.Name = "temp" 'Rename worksheet to make way for worksheet loaded from .CSV file
CSVFileName = FolderName & NewSheets(i) & ".csv" 'Build .CSV file full path name
'MsgBox CSVFileName
'Open CSV file in new workbook
Workbooks.OpenText Filename:=CSVFileName, Origin:=xlWindows, DataType:=xlDelimited, Comma:=True
ActiveSheet.Move after:=wsTemp 'Move worksheet into workbook being built
'Note: Seems like moving the last remaining worksheet out of a workbook closes the (empty) workbook, at least in Microsoft Office Excel 2003 (11.8346.8341) SP1
'Note: And if "Set wbTemp = ActiveWorkbook" is done before ActiveSheet.Move, then wbTemp.Close fails with Run-time error '-2147221080 (800401a8)': Method 'Close' of object '_Workbook' failed.
wsTemp.Delete 'Remove placeholder worksheet
End If
Next i
 
Back
Top