[ xl_kid @ 23.07.2014. 11:13 ] @
Poštovani,

potrebna mi je pomoć oko izrade progres bara. Naime, hteo bih da prilikom kopiranja iz jedne tabele u drugu (dve različite baze) ubacim i progres bar (estetike radi). Na netu sam našao više primera ali nikako ne mogu da ih prilagodim mom kodu pa molim za malo pomoći ako neko ima ideju.

'********************************************************************************
'na formi imam ovaj kod koji pozivam na click
Option Compare Database
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function ProgressDemo()
Dim prg As clsProgress
Dim i As Integer

Set prg = New clsProgress

prg.Init 100, "Obrada u toku", "Ažuriranje..."
prg.Show

'1. korak
DoCmd.OpenQuery ("Q_DEL_PROD_CENOVNIK_STAVKA") 'delete query, briše tabelu
For i = 1 To 100

prg.SecondaryText = "Priprema cenovnika S " & i & " od " & prg.Total
Sleep 50
prg.Update

DoEvents
Next i

'2. korak

prg.Clear
prg.FloodColor = vbGreen
prg.BarTextColor = vbBlue
DoCmd.OpenQuery ("Q_DEL_PROD_CENOVNIK") 'delete query, briše tabelu
For i = 1 To 100


prg.SecondaryText = "Priprema cenovnika Z " & i & " od " & prg.Total
Sleep 50
prg.Update
DoEvents
Next i

'3. korak

prg.Clear
prg.FloodColor = vbGreen
prg.BarTextColor = vbBlue
DoCmd.OpenQuery ("Q_DEL_T_PROD_RELACIJE") 'delete query, briše tabelu
For i = 1 To 100


prg.SecondaryText = "Priprema relacija " & i & " od " & prg.Total
Sleep 50
prg.Update
DoEvents
Next i

'4. korak

prg.Clear
prg.FloodColor = vbGreen
prg.BarTextColor = vbBlue
DoCmd.OpenQuery ("Q_APEND_T_PROD_CENOVNIK") 'kopira tabelu iz druge baze
For i = 1 To 100


prg.SecondaryText = "Ažuriranje cenovnika " & i & " od " & prg.Total
Sleep 50
prg.Update
DoEvents
Next i

'5. korak

prg.Clear
prg.FloodColor = vbGreen
prg.BarTextColor = vbBlue
DoCmd.OpenQuery ("Q_APEND_PROD_CENOVNIK_STAVKA") 'kopira tabelu iz druge baze
For i = 1 To 100


prg.SecondaryText = "Ažuriranje cenovnika " & i & " od " & prg.Total
Sleep 50
prg.Update
DoEvents
Next i

'6. korak

prg.Clear
prg.FloodColor = vbGreen
prg.BarTextColor = vbBlue
DoCmd.OpenQuery ("Q_APN_T_PROD_RELACIJA") 'kopira tabelu iz druge baze
For i = 1 To 100

prg.SecondaryText = "Ažuriranje relacija " & i & " od " & prg.Total
Sleep 50
prg.Update
DoEvents
Next i

Set prg = Nothing

End Function
'********************************************************************************

modul

Option Compare Database
Option Explicit


'Constants to reference the progress form and
'it's objects/properties.
Const PRG_HOSTFORM = "frmProgress" 'Name of the mainform
Const PRG_METER_CONTROL = "ctlMeter" 'Name of the subform control
Const PRG_TXT_PRIMARY_LABEL = "lblPrimaryText" 'Name of the first text label
Const PRG_TXT_SECONDARY_LABEL = "lblSecondaryText" 'Name of the second text label

'property variables
Private m_Total As Long 'RW
Private m_PrimaryText As String 'RW
Private m_SecondaryText As String 'RW
Private m_FloodColor As Long 'RW
Private m_BarText As String 'RW
Private m_BarTextColor As Long 'RW

'private variables (not exposed)
Private frm As Access.Form 'the main form
Private meter As Object 'the subform (form, not control)

'not exposed, used to set the text on the primary or secondary control
Private Enum TextType
Primary = 0
Secondary = 1
End Enum


'========================
Public Sub Init( _
TotalCount As Long, _
Optional PrimaryTxt As String = "", _
Optional SecondaryTxt As String = "", _
Optional FloodColorCode As Long = 4259584, _
Optional BarTxt As String = "", _
Optional BarTxtColor As Long = 0 _
)

'init the objects
DoCmd.OpenForm PRG_HOSTFORM, acNormal, , , , acHidden
Set frm = Forms(PRG_HOSTFORM)
Set meter = frm.Controls(PRG_METER_CONTROL).Form

'init the properties
PrimaryText = PrimaryTxt
SecondaryText = SecondaryTxt
FloodColor = FloodColorCode
Total = TotalCount
BarText = BarTxt
BarTextColor = BarTxtColor

End Sub

Public Sub Show()
frm.Visible = True
frm.Repaint
End Sub

Public Sub Clear()
meter.Clear
Total = Total 'forces a reset of the meter counts
End Sub

Public Sub Update()
meter.Update
End Sub

Private Sub UpdateText(tt As TextType, text As String)
Dim sControl As String

If tt = Primary Then
sControl = PRG_TXT_PRIMARY_LABEL
Else
sControl = PRG_TXT_SECONDARY_LABEL
End If

frm.Controls(sControl).Caption = text
frm.Repaint
End Sub

Private Sub UpdateFloodColor(L As Long)
meter.FloodColor = L
frm.Repaint
End Sub

Private Sub UpdateMaxCount(L As Long)
meter.MaxCount = L
End Sub

Private Sub UpdateBarText(s As String)
meter.text = s
meter.Repaint
End Sub

Private Sub UpdateBarTextColor(L As Long)
meter.TextColor = L
meter.Repaint
End Sub

'=============================

Public Property Get BarTextColor() As Long
BarTextColor = m_BarTextColor
End Property
Public Property Let BarTextColor(L As Long)
m_BarTextColor = L
UpdateBarTextColor L
End Property

Public Property Get BarText() As String
BarText = m_BarText
End Property
Public Property Let BarText(s As String)
m_BarText = s
UpdateBarText s
End Property

Public Property Get FloodColor() As Long
FloodColor = m_FloodColor
End Property
Public Property Let FloodColor(L As Long)
m_FloodColor = L
UpdateFloodColor L
End Property

Public Property Get PrimaryText() As String
PrimaryText = m_PrimaryText
End Property
Public Property Let PrimaryText(s As String)
m_PrimaryText = s
UpdateText Primary, s
End Property

Public Property Get SecondaryText() As String
SecondaryText = m_SecondaryText
End Property
Public Property Let SecondaryText(s As String)
m_SecondaryText = s
UpdateText Secondary, s
End Property

Public Property Get Total() As Long
Total = m_Total
End Property
Public Property Let Total(L As Long)
m_Total = L
UpdateMaxCount L
End Property




Private Sub Class_Initialize()
'
End Sub

Private Sub Class_Terminate()
Set meter = Nothing
Set frm = Nothing
If pfIsFormOpen(PRG_HOSTFORM) Then DoCmd.Close acForm, PRG_HOSTFORM, acSaveNo
End Sub


Private Function pfIsFormOpen(sFormName As String) As Boolean
On Error Resume Next
Dim x
x = Forms(sFormName).Caption
pfIsFormOpen = Not CBool(err.Number)
End Function
'*************************************************************

Kako da podesim vreme tj brzinu "pomeranja" progres bara u zavisnosti količine podataka koji se prebacuju jer neke tabele imaju više podataka a neke manje.