bonjour,
j'ai créé une macro qui recherche des mises à jour sur une dizaine de tableau et j'aimerai faire une barre de progression qui s'actualise dès de la macro change de tableau.
je vous laisse un petit exemple...
Pourquoi ma barre ne progresse pas?
merci d'avance
j'ai créé une macro qui recherche des mises à jour sur une dizaine de tableau et j'aimerai faire une barre de progression qui s'actualise dès de la macro change de tableau.
je vous laisse un petit exemple...
Pourquoi ma barre ne progresse pas?
merci d'avance
Code:
Private Sub Oui_Click()
Dim ST As Worksheet 'declare la variable sS
Dim M As Worksheet 'déclare la variable MAJ (feuille MAJ)
Dim V As Worksheet 'déclare la variable V
Dim PL As Range 'déclare la variable PL (PLage)
Dim R As Range 'déclare la variable R
Dim TD() As Variant 'déclare la variable TD (Tableau des Différences)
Dim i As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim sup As Integer
Dim tablo, dico
Unload Me 'ferme serveur
'charge la barre de progression
progression = 0
BarreProgression.Show vbModeless
BarreProgression.Caption = "Vérification des mises à jour ..."
progression = progression + 1
BarreProgression.Image_barre.Width = progression * 1.95
DoEvents
BarreProgression.Repaint
'-----------------------------------remplissage tableau S maj-------------------------------------------
With Sheets("S maj")
Set ST = Worksheets("S maj") 'définit l'onglet F
Set M = Worksheets("MAJ") 'définit l'onglet M
Set PL = ST.Range("A1").CurrentRegion 'définit la plage PL
'compare la colonne 1 avec la 2
For i = 2 To ST.Range("A1").CurrentRegion.Rows.Count 'boucle sur toutes les lignes I de la plage PL
If ST.Cells(i, 1).Value <> "" Then 'condition 1 : si la cellule ligne I colonne 1 n'est pas vide
'définit la recherche R (recherche dans la colonne 2 de la plage PL la valeur entière de la cellule ligne I colonne 1)
Set R = Application.Intersect(PL, ST.Columns(2)).Find(ST.Cells(i, 1), , xlValues, xlWhole)
If R Is Nothing Then 'condition 2 : si aucune occurrence n'est trouvée
ReDim Preserve TD(J) 'redimensionne le tableau des différences TD
TD(J) = ST.Cells(i, 1) 'récupère dans la tableau TD la valeur de la cellule ligne I, colonne 1
J = J + 1 'incrémente J
End If 'fin de la condition 2
End If 'fin de la condition 1
Next i 'prochaine ligne de la boucle
If J < 1 Then
With Sheets("S maj")
tablo = Range("MAJS2").Value
Set dico = CreateObject("scripting.dictionary")
dico.comparemode = vbTextCompare
For i = 1 To UBound(tablo): dico(tablo(i, 2)) = "": Next i
For i = 1 To UBound(tablo)
If dico.exists(tablo(i, 1)) Then tablo(i, 1) = ""
Next i
i = 1
Range("MAJS2") = tablo
End With
Else
'renvoie dans C2 redimensionnées le tableau TD transposé
M.Range("C3").Resize(UBound(TD) + 1, 1).Value = Application.Transpose(TD)
With Sheets("MAJ")
For i = .Cells(2, 1).End(xlDown).Row To 1 Step -1
If .Cells(i, 3).Value <> "" And .Cells(i, 2) = "" Then
.Cells(i, 2).Value = "S"
End If
Next i
End With
With Sheets("S maj")
tablo = Range("MAJS2").Value
Set dico = CreateObject("scripting.dictionary")
dico.comparemode = vbTextCompare
For i = 1 To UBound(tablo): dico(tablo(i, 2)) = "": Next i
For i = 1 To UBound(tablo)
If dico.exists(tablo(i, 1)) Then tablo(i, 1) = ""
Next i
i = 1
Range("MAJS2") = tablo
End With
End If
End With
progression = progression + 1
BarreProgression.Repaint
'--------------------------------------remplissage tableau V maj---------------------------------------------
With Sheets("V maj")
Set V = Worksheets("V maj") 'définit l'onglet V
Set M = Worksheets("MAJ") 'définit l'onglet M
Set PL = V.Range("A1").CurrentRegion 'définit la plage PL
'compare la colonne 1 avec la 2
For i = 2 To V.Range("A1").CurrentRegion.Rows.Count 'boucle sur toutes les lignes I de la plage PL
If V.Cells(i, 1).Value <> "" Then 'condition 1 : si la cellule ligne I colonne 1 n'est pas vide
'définit la recherche R (recherche dans la colonne 2 de la plage PL la valeur entière de la cellule ligne I colonne 1)
Set R = Application.Intersect(PL, V.Columns(2)).Find(V.Cells(i, 1), , xlValues, xlWhole)
If R Is Nothing Then 'condition 2 : si aucune occurrence n'est trouvée
ReDim Preserve TD(J) 'redimensionne le tableau des différences TD
TD(J) = V.Cells(i, 1) 'récupère dans la tableau TD la valeur de la cellule ligne I, colonne 1
J = J + 1 'incrémente J
End If 'fin de la condition 2
End If 'fin de la condition 1
Next i 'prochaine ligne de la boucle
If J < 1 Then
With Sheets("V maj")
tablo = Range("MAJV").Value
Set dico = CreateObject("scripting.dictionary")
dico.comparemode = vbTextCompare
For i = 1 To UBound(tablo): dico(tablo(i, 2)) = "": Next i
For i = 1 To UBound(tablo)
If dico.exists(tablo(i, 1)) Then tablo(i, 1) = ""
Next i
i = 1
Range("MAJV") = tablo
End With
Else
'renvoie dans C2 redimensionnées le tableau TD transposé
M.Range("C3").Resize(UBound(TD) + 1, 1).Value = Application.Transpose(TD)
With Sheets("MAJ")
For i = .Cells(2, 1).End(xlDown).Row To 1 Step -1
If .Cells(i, 3).Value <> "" And .Cells(i, 2) = "" Then
.Cells(i, 2).Value = "V"
End If
Next i
End With
With Sheets("V maj")
tablo = Range("MAJV").Value
Set dico = CreateObject("scripting.dictionary")
dico.comparemode = vbTextCompare
For i = 1 To UBound(tablo): dico(tablo(i, 2)) = "": Next i
For i = 1 To UBound(tablo)
If dico.exists(tablo(i, 1)) Then tablo(i, 1) = ""
Next i
i = 1
Range("MAJV") = tablo
End With
End If
End With
progression = progression + 1
BarreProgression.Repaint
End Sub
