C1. Form BOCSoft Sample dan form fldgProgress
C2. clsProgress.

Form BOCSoft sample akan memanggil class clsProgress yang akan memanggil form flgProgress. 

Inilah kodingnya:

C1. Form BOCSoft Sample

Private Sub btnRun_Click()
Dim mlngCount As Long
Dim CProgress As clsProgress
Set CProgress = New clsProgress
CProgress.OpenProgress
CProgress.MaxValue = 5000
For mlngCount = 1 To CProgress.MaxValue
   CProgress.SetProgressMeter mlngCount
Next mlngCount
CProgress.CloseProgress
Set CProgress = Nothing
End Sub

C2. clsProgress

Option Compare Text
Option Explicit

Private mlngMaxValue As Long
Public Property Let MaxValue(value As Long)
   mlngMaxValue = value
End Property

Public Property Get MaxValue() As Long
   MaxValue = mlngMaxValue
End Property

Public Sub OpenProgress()
   DoCmd.OpenForm “fdlgProgress”, acNormal
End Sub

Public Sub CloseProgress()
   DoCmd.Close acForm, “fdlgProgress”
End Sub

Public Sub SetProgressMeter(lngPresentValue As Long, Optional strCaption As String)
‘Purpose :

Const cstrProc As String = “SetProgressMeter”

On Error GoTo Err_Trap

If Not Forms(”fdlgProgress”).ctlProgress.Visible Then
   Forms(”fdlgProgress”).ctlProgress.Visible = True
   Forms(”fdlgProgress”).lblComplete.Visible = True
End If

Forms(”fdlgProgress”).ctlProgress.Max = Me.MaxValue

If lngPresentValue > Forms(”fdlgProgress”).ctlProgress.Max Then
   lngPresentValue = Forms(”fdlgProgress”).ctlProgress.Max
End If
Forms(”fdlgProgress”).ctlProgress.value = lngPresentValue
Forms(”fdlgProgress”).lblComplete.Caption = _
   Format((Forms(”fdlgProgress”).ctlProgress.value / Forms(”fdlgProgress”).ctlProgress.Max) * 100, “##”) & ” % Complete”

DoCmd.RepaintObject
Forms(”fdlgProgress”).Caption = strCaption

Err_Exit:

On Error GoTo 0

Exit Sub

Err_Trap:
MsgBox “Error No. : ” & Err.Number & vbCrLf & “Error Descr : ” & Err.Description
Resume Err_Exit

End Sub

Download Sample