Comment affichier un statut d'avancement sous VB

Question

Bonjour,

J'ai développé un petit VB et je voudrais y incorporer lors du lancement un message permettant de voir son statut.

Le VB est fait de manière à lire ligne à ligne un onglet d'un fichier excel, donc il va lire les 65536 lignes.

Mon souhait est d'afficher à chaque passage de ligne la ligne où il se trouve. L'idéal est de savoir sur combien de ligne renseignée.

le VB contient un objet 

Dim r as long

avec r = r +1  à chaque passage de ligne avec un loup sur une cellule qui doit être renseignée.

Merci d'avance de votre réponse!

lillith212 · Answer

Bonjour,

Je veux bien donner une réponse mais il n'y a pas de question...
Juste ce que tu as fait (ton appli vb), ce que tu souhaite (ton attente),
Enfin je comprends rien à :
le VB contient un objet 
Dim r as long
avec r = r +1  à chaque passage de ligne avec un loup sur une cellule qui doit être renseignée.

Bon courage

S.L.B.
<hr />-- Le règlement tu liras -- Des recherches tu feras -- Le style SMS tu banniras --
-- De la validation pertinente tu feras -- Du respect tu auras -- <

Rayan75008 · Answer

Bonjour,

Ok, voici mon VB, comme tu peux le constater il fait une lecture de chaque ligne et je voudrais ajouter un message (type msgbox) indiquant où le programme en est! Merci encore!

Private Sub CommandButton1_Click()
Dim intMsg As Integer
Dim strReponse As String
Dim Responsel As Long
Dim r As Long, c As Long
Dim f As Long
f = FreeFile
'colonne h
Dim ha As Long
Dim hb As Long
Dim hc As Long
'colonne i
Dim ia As Long
Dim ib As Long
Dim ic As Long
'colonne j
Dim ja As Long
Dim jb As Long
Dim jc As Long
'colonne k
Dim ka As Long
Dim kb As Long
Dim kc As Long
'colonne l
Dim la As Long
Dim lb As Long
Dim lc As Long
'colonne m
Dim mb As Long
Dim mc As Long
'colonne n
Dim nb As Long
Dim nc As Long
'colonne o
Dim ob As Long
Dim oc As Long
'colonne p
Dim pb As Long
Dim pc As Long
'colonne q
Dim qb As Long
Dim qc As Long
'colonne r
Dim rb As Long
Dim rc As Long
'colonne s
Dim sb As Long
Dim sc As Long
'colonne t
Dim tb As Long
Dim tc As Long
'colonne u
Dim ub As Long
Dim uc As Long
'colonne v
Dim vb As Long
Dim vc As Long
'colonne w
Dim wb As Long
Dim wc As Long
'colonne x
Dim xa As Long
Dim xb As Long
Dim xc As Long
'colonne y
Dim yb As Long
Dim yc As Long
Open "c:	emp\upload.dat" For Output As #f
intMsg = MsgBox("Voulez Vous lancer l'extration?", vbOKCancel)
If intMsg = 1 Then
      r = 4
        Do
           If Cells(r, 1) = 1 Then _
ha = 20
ia = 15
ja = 4
ka = 2
la = 1
xa = 60


hb = Len(Cells(r, 8))
ib = Len(Cells(r, 9))
jb = Len(Cells(r, 10))
kb = Len(Cells(r, 11))
lb = Len(Cells(r, 12))
mb = Len(Cells(r, 13))
nb = Len(Cells(r, 14))
ob = Len(Cells(r, 15))
pb = Len(Cells(r, 16))
qb = Len(Cells(r, 17))
rb = Len(Cells(r, 18))
sb = Len(Cells(r, 19))
tb = Len(Cells(r, 20))
ub = Len(Cells(r, 21))
vb = Len(Cells(r, 22))
wb = Len(Cells(r, 23))
xb = Len(Cells(r, 24))
yb = Len(Cells(r, 25))


hc = ha - hb
ic = ia - ib
jc = ja - jb
kc = ka - kb
lc = la - lb
mc = ha - mb
nc = ha - nb
oc = la - ob
pc = ha - pb
qc = ha - qb
rc = la - rb
sc = ha - sb
tc = la - tb
uc = ha - ub
vc = ha - vb
wc = ha - wb
xc = xa - xb
yc = ha - yb




                Print #f, Cells(r, 8) & Space(hc) & Cells(r, 9) & Space(ic) & _
                     Cells(r, 10) & Space(jc) & Cells(r, 11) & Space(kc) & Cells(r, 12) & Space(lc) & Cells(r, 13) & Space(mc) & _
                     Cells(r, 14) & Space(nc) & Cells(r, 15) & Space(oc) & Cells(r, 16) & Space(pc) & Cells(r, 17) & Space(qc) & _
                     Cells(r, 18) & Space(rc) & Cells(r, 19) & Space(sc) & Cells(r, 20) & Space(tc) & Cells(r, 21) & Space(uc) & _
                     Cells(r, 22) & Space(vc) & Cells(r, 23) & Space(wc) & Cells(r, 24) & Space(xc) & Cells(r, 25) & Space(yc)
                                            r = r + 1
                         Loop Until Cells(r, 8) = vbNullString ' tests de dernière ligne ( cellule 1 vide ...)
            strReponse = MsgBox("Fin de l'extraction")
            
            Else
    End If
    
Close #f


End Sub


'strReponse = MsgBox("Aucune Extraction réalisée")

jmfmarques · Answer

http://www.vbfrance.com/forum/sujet-FONCTION-PRINT-AVEC-CONDITION_1222424.aspx

Comment affichier un statut d'avancement sous VB

3 réponses

Votre réponse

Discussions similaires