• ** There has been a recent site upgrade. Please clear your browser cache to avoid issues. **
  • New forum feature - post voting and best solution

    Check out this thread for the details: https://www.access-programmers.co.uk/forums/threads/new-forum-feature-post-voting-and-best-answer.314134/

    This new feature looks great to me! :)

  • We now have 3 forum themes

    Go for the default (light) theme, Shades of Grey or Shades of Blue. I just added the Blue one.

    The thread about it is here: https://www.access-programmers.co.uk/forums/threads/new-forum-theme-shades-of-blue.314136/

Progress Bar (1 Viewer)

wayne123

New member
Local time
Today, 20:03
Joined
Aug 4, 2020
Messages
7
Good Morning All,

I have a "Simple" problem that I'm struggling to solve.

My code loops through multiple txt files in a specific fold and converts them to excel files.

I'm developing a piece of code to show the user the Progress of conversion of each file. What do I need to change to make it count files opened (As part of the percentage progress)?

Code:
 'Calculate Progress
  
  
   CurrentProgress = xlOpenXMLWorkbook
   BarWidth = UserForm1.Progress.Width * CurrentProgress
   ProgressPercentage = Round(CurrentProgress * 100, 0)
  
  
   UserForm1.Bar.Width = BarWidth
   UserForm1.Text.Caption = ProgressPercentage & "% Complete"


UserForm1.Bar.Width = BarWidth
UserForm1.Text.Caption = ProgressPercentage & "% Complete"
 

Minty

AWF VIP
Local time
Today, 20:03
Joined
Jul 26, 2013
Messages
7,370
You'll need to add a

Form.Repaint

after you change the caption to see them update.
 

wayne123

New member
Local time
Today, 20:03
Joined
Aug 4, 2020
Messages
7
Hi, Thanks for the reply. I can't seem to add this into the code?

Here's the full Code:

Code:
Public Sub Convert_TXT_XLS()
    Dim sFolder As String
    Dim fd As FileDialog
    Dim strFile As String
    Dim booResult As Boolean
    
       'Progress Bar
    Dim CurrentProgress As Double
    Dim ProgressPercentage As Double
    Dim BarWidth As Long
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.AllowMultiSelect = False
    fd.Title = "Select database folder"
    If fd.Show = True Then
        'folder path was selected
        booResult = True
        sFolder = fd.SelectedItems(1)
    End If
    If Len(sFolder) > 0 Then
        Call LoopAllFiles(sFolder)
    End If
End Sub




Sub LoopAllFiles(ByVal sPath As String)
    Dim sDir As String
    Dim objXl As Object
    Dim objWB As Object
    Dim objSH As Object
    Const xlDelimited As Integer = 1
    Const xlDoubleQuote As Integer = 1
    Const xlOpenXMLWorkbook As Integer = 51
    
 
    
    'Exit Macro if cancelled
     Application.StatusBar = False
    Application.DisplayAlerts = True
    

    
    'sPath = "C:\work\"
    Set objXl = CreateObject("Excel.Application")
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Set objWB = objXl.Workbooks.Open(sPath & sDir)
        Set objSH = objWB.Sheets(1)
        
            'Progress Bar (Userform)

    Call InitiateProgressBar
        
        'Calculate Progress
  
  
   CurrentProgress = xlOpenXMLWorkbook
   BarWidth = UserForm1.Progress.Width * CurrentProgress
   ProgressPercentage = Round(CurrentProgress * 100, 0)
  
  
  
   UserForm1.Bar.Width = BarWidth
   UserForm1.Text.Caption = ProgressPercentage & "% Complete"
  
   DoEvents
        
        With objSH
            objXl.Selection.TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
        End With
        objWB.SaveAs FileName:=Left(objWB.FullName, InStrRev(objWB.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        objWB.Close False
        Set objSH = Nothing
        Set objWB = Nothing
        sDir = Dir$
    Loop
    
    'Unload Progress
  
   Unload UserForm1
  
    objXl.Quit
    Set objXl = Nothing

End Sub

Sub InitiateProgressBar()


With UserForm1


 .Bar.Width = 0
 .Text.Caption = "0% Complete"
 .Show vbModeless
 



End With


End Sub
 

Gasman

Enthusiastic Amateur
Local time
Today, 20:03
Joined
Sep 21, 2011
Messages
6,863
You would need to find out how many files will be processed.
Then increment a counter as each file is processed, calculate the percentage and repaint as mentioned.?

However you appear to be doing this in Excel?, not sure a repaint is available. Just checked and it is.(y)

In a progress box I use the code is

Code:
    ProgressBox.Increment Int(iloop / iTotal * 100), "Working on " & strTicker '& " " & Int(iloop / iTotal * 100) & "% completed"
 

Minty

AWF VIP
Local time
Today, 20:03
Joined
Jul 26, 2013
Messages
7,370
Sorry I didn't spot this in Excel, I assumed (incorrectly) it was in the wrong forum section.
I'll bow out as I've never used a progress bar in Excel, but can't imagine it's much different?
 

Isaac

Lifelong Learner
Local time
Today, 13:03
Joined
Mar 14, 2017
Messages
2,479
I'm having trouble following the way you're separating your progress bar procedure from the rest of the code and the variables seem to end up a little here & everywhere ... I'll post the way I do progress bars in Excel and maybe it will give you some ideas.

I always have a userform, frmProgress, with a "bottom" label and a "top" label (sits on top of the bottom label). The bottom label's backcolor is something bland. The top label's backcolor is blue. Both labels stretch out the same horizontal width as the form itself. The height of the form is small - maybe a half inch. The concept is to adjust the width of the top label as a percentage of the bottom label, like 50% if we are 50% done with the process, so it appears 50% progress.

Testing 20200825.png


Code:
Sub ShowProgress(blShow As Boolean, Optional strCaption As String, Optional dblPercentage As Double)
If blShow = False Then
    frmProgress.Hide
    Exit Sub
Else
    frmProgress.Show vbModeless
    frmProgress.lblInner.Caption = "  "
    frmProgress.lblOuter.Caption = "  "
    frmProgress.Caption = strCaption
    frmProgress.lblInner.Width = frmProgress.lblOuter.Width * dblPercentage
    frmProgress.Repaint
End If
End Sub

Code:
Sub SomeProcedure()
dim lngCurrent as long, lngTotal as long
lngTotal = [some method of knowing the total loop iterations beforehand]

For Each Something in Something
    lngCurrent=lngCurrent + 1
    ShowProgress True, "Processing item " & lngCurrent & " out of " & lngTotal, CDbl(lngCurrent / lngTotal)
    '.....Do stuff here
Next Something
End Sub

Super simple. HTH
 
Last edited:

Users who are viewing this thread

Top Bottom