[ 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. |