Run Progress Bar ระหว่างขั้นตอน Refresh Data Web Query

[myboyzaa]

รบกวนสอบถามครับอาจารย์ ผมงงมากกับการ Add Userform Progress Bar แล้วสั่งให้มันทำงาน ระหว่างการ Refresh Data Web Query รบกวนช่วยแนะนำหรือช่วยปรับ Code ให้หน่อยนะครับ

Code: Select all

Sub code()


  Dim wks As Worksheet
  Dim qt As QueryTable
  Dim lo As ListObject
  Dim pctCompl As Single
  
  For Each wks In Worksheets
    For Each qt In wks.QueryTables
        qt.Refresh BackgroundQuery:=False
    Next qt

    For Each lo In wks.ListObjects
        lo.QueryTable.Refresh BackgroundQuery:=False
    Next lo

  Next wks

  Set qt = Nothing
  Set wks = Nothing
  
    pctCompl = lo
    progress pctCompl
    

End Sub

Code: Select all

Sub progress(pctCompl As Single)

UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2

DoEvents

End Sub

ตัวอย่างตามไฟล์แนบครับ ขอบคุณครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub code()
  Dim wks As Worksheet
  Dim qt As QueryTable
  Dim lo As ListObject
  Dim pctCompl As Single
  Dim i As Integer, total_lo As Long

  totalQt = Count_Qt(qt)
  For Each wks In Worksheets

    For Each qt In wks.QueryTables
        qt.Refresh BackgroundQuery:=False
        i = i + 1
    Next qt

    For Each lo In wks.ListObjects
        lo.QueryTable.Refresh BackgroundQuery:=False
    Next lo
    If i > 0 Then
        UserForm1.Text.Caption = 100 * (i / totalQt) & "% Completed"
        UserForm1.Bar.Width = UserForm1.Frame1.Width * i / totalQt
    End If
  Next wks

  Set qt = Nothing
  Set wks = Nothing
  
'    pctCompl = lo
'    progress pctCompl

End Sub

Function Count_Qt(objQt As Object) As Long
    Dim sh As Worksheet
    For Each sh In Worksheets
        For Each objQt In sh.QueryTables
            Count_Qt = Count_Qt + 1
        Next objQt
    Next sh
End Function