pourcentage et message box...

Salut Hervé,
Je vois que tu n'aime pas l'emploi du tableau mais je te passe un code que
tu peux tester avec un affichage de durée en fin de proc avec les deux
façons. En mettant comme valeur maxi 40000 (lignes) et comme pas 1( donc
copie de toutes les lignes), il a fallu sur mon PC 12 secondes avec le
tableau et 3,06 minutes avec la copie des lignes.
Tu peux utiliser la même Form pour récupérer le nombre de lignes maxi et le
pas en ajoutant des contrôles que tu masques ensuite durant la progression
de la proc ou alors, utiliser 2 InputBox successives. Le pourcentage est
affiché dans le Caption de la Form mais tu peux aussi ultiliser un Label
supplémantaire auquel tu mets la propiété "BackStyle" sur 0 (transparent) et
tu le fais se déplacer en fonction de l'avancement avec un "ForeColor"
blanc.
Mets le code ci-dessous dans le module de ta Form :

'API servant au calcul du temps (à supprimer après test avec ce qui va avec)
Private Declare Function GetTickCount Lib "Kernel32" () As Long
'en metant :
'1 TextBox nommé TxtMaxi pour le nombre de lignes
'1 TextBox nommé TxtPas pour le pas
'1 Label nommé LblMaxi pour indiquer le champ Maxi
'1 Label nommé LblPas pour indiquer le champ Pas
'1 Label nommé LblAffiche pour le pourcentage
'dont les propriétés :
'"BackStyle" = 0 (transparent)
'"ForeColor" = &H00FFFFFF& (Blanc)
'"Left" comme LblProgress
'"Width" de façon à pouvoir afficher 100%
'"Caption" = "100%" puis après avoir réglé Width supprimer
'1 CommadButton nommé CmdOK pour lancer la proc
'1 CommadButton nommé CmdAnnuler
'et la barre de progression nommée LblProgress
'avec False à la propriété "Visible" car elle sera
'affichée en temps voulue

Sub demarre()
progbar.Show
End Sub

Private Sub CmdAnnuler_Click()
Unload Me
End Sub

Private Sub CmdOK_Click()
Dim ProgressLargeur
Dim I As Long, J As Long
Dim Debut As Long

Debut = GetTickCount()

With progbar
.TxtMaxi.Visible = False
.TxtPas.Visible = False
.LblMaxi.Visible = False
.LblPas.Visible = False
.CmdAnnuler.Visible = False
.CmdOK.Visible = False
.LblProgress.Visible = True
End With

ProgressLargeur = progbar.LblProgress.Width
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual ' si applicable

LblProgress.Width = 0
' si une valeur non numérique dans les textbox
On Error GoTo Fin
'mets en commentaire la ligne
'que tu ne veux pas tester :
'ParLigne TxtMaxi, TxtPas, ProgressLargeur
ParTableau TxtMaxi, TxtPas, ProgressLargeur
Fin:
If Err.Number <> 0 Then
MsgBox "Valeurs non numériques !"
End If
Unload progbar

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic ' si applicable

MsgBox Format((GetTickCount() - Debut) / 1000, "00:00:00")

End Sub

Sub ParLigne(Maxi As Long, _
Pas As Integer, _
ByVal ProgressLargeur As Integer)
Dim I As Long, J As Long

J = 1

With Worksheets("Feuil1")
For I = 1 To Maxi Step Pas
.Rows(I).Copy Worksheets("Feuil2").Rows(J)
J = J + 1
LblProgress.Width = (I / Maxi) * ProgressLargeur
progbar.Caption = CInt((I / Maxi) * 100) & "%"
With LblAffiche
.Caption = CInt((I / Maxi) * 100) & "%"
If LblProgress.Width < .Width Then
.Left = LblProgress.Left
Else
.Left = LblProgress.Width / 2
End If
End With
DoEvents
Next
End With

End Sub

Sub ParTableau(Maxi As Long, _
Pas As Integer, _
ByVal ProgressLargeur As Integer)
Dim Tbl
Dim I As Long
Dim J As Integer
Dim K As Long
Dim Colonne As Long

With Worksheets("Feuil1")
'recherche la dernière colonne
Colonne = .Cells.Find("*", .[A1], xlFormulas, , _
xlByColumns, xlPrevious).Column
'rempli le tableau
Tbl = .Range(.Cells(1, 1), .Cells(Maxi, Colonne))
End With

'déplace les valeurs dans le tableau
For I = 1 To Maxi Step Pas
K = K + 1
For J = 1 To Colonne
Tbl(K, J) = Tbl(I, J)
Next J
LblProgress.Width = (I / Maxi) * ProgressLargeur
progbar.Caption = CInt((I / Maxi) * 100) & "%"
With LblAffiche
.Caption = CInt((I / Maxi) * 100) & "%"
If LblProgress.Width < .Width Then
.Left = LblProgress.Left
Else
.Left = LblProgress.Width / 2
End If
End With
DoEvents
Next I
'colle le résultat dans la feuille
With Worksheets("Feuil2")
.Range(.Cells(1, 1), .Cells(K, Colonne)) = Tbl
End With
Erase Tbl
End Sub

reviens si tu as un problème ou si tu veux autre chose.
Hervé.

"Hervé Frank-Dangel" <nospam-hfrankdangel@frog-sa.com> a écrit dans le
message news: eTZX6pSVEHA.2972@TK2MSFTNGP11.phx.gbl...

Alors voila:

Pour finaliser completement mon projet, il me reste deux point:

1) serait il possible de greffer l'affichage du pourcentage effectué dans
la

progress bar ?? (voir plus bas le code...)

2) Le top du top: une message box au lancement de ma macro, qui me
permetterais de rentrer le nombre de lignes de mon fichier
et le pourcentage de l'echantillon desiré ( en fait le pas)

le but est de parametrer ces deux critères dans la boite de dialogue au
lancement pour que la macro ne soit pas spécifique à un seul cas...
comment faire pour que a partir de ma boite de dialogue je puisse changer
les critères entre ** :

For i = 1 To ****33440**** Step ****10****

merci bien, la communauté est bien cool et hyper volontaire,
merci de partager vos connaissances

@+


Private Sub UserForm_Activate()
Macro30
End Sub



Sub demarre()
progbar.Show
End Sub

Sub Macro30()

Dim i As Long, j As Long
ProgressLargeur = progbar.Label1.Width
Application.ScreenUpdating = False
progbar.Label1.Width = 0

j = 1
Application.Calculation = xlCalculationManual ' si
applicable

With Worksheets("Feuil1")
For i = 1 To 33440 Step 10
.Rows(i).Copy Worksheets("Feuil2").Rows(j)
j = j + 1
progbar.Label1.Width = (i / 33440) * ProgressLargeur
DoEvents
Next
Unload progbar

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic ' si
applicable
End Sub