Discussion :

[Soyanlo]

Bonjour,

Je viens vers vous car j'ai un problème avec un traitement qui est extrêmement long.
Je demande à l'utilisateur de renseigner des champs qui seront ensuite utilisés pour changer des champs d'un fichier ReportMan. Puis d'imprimer le dit fichier.

Le fichier est crée avec des valeurs par défauts, l'application le copie et lui donne les valeurs saisies par l'utilisateur.

Voici la procédure qui me permet de faire la modification de la chaine correspondante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub ReplaceString(ByVal strFichier, ByVal strOldString, ByVal strNewString)
 
        On Error Resume Next
 
        Dim strTemp = Application.StartupPath & "\File.tmp"
 
        Dim nIn = FreeFile()
        FileOpen(nIn, strFichier, OpenMode.Input)
 
        Dim nOut = FreeFile()
        FileOpen(nOut, strTemp, OpenMode.Output)
 
        Do While Not EOF(nIn)
            Dim strLigne = LineInput(nIn)
            strLigne = Replace(strLigne, strOldString, strNewString)
            PrintLine(nOut, strLigne)
        Loop
 
        FileClose(nOut)
        FileClose(nIn)
 
        FileCopy(strTemp, strFichier)
        Kill(strTemp)
 
    End Sub

elle est appelé comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", "<%item_01%>", MaskedTextBox1.Text)
ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", "<%prix_01%>", MaskedTextBox2.Text)
If MaskedTextBox3.Text <> "" Then
        ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", "<%cent_01%>", "." & MaskedTextBox3.Text & "€")
Else
        ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", "<%cent_01%>", "")
End If

Ceci est le traitement sur 1 produit, il le fait en tout sur 16 produits.

Dans cet exemple <%item_01%> est le champ par défaut du fichier qui doit être remplacer par la valeur du MaskedTextBox1.Text.

Le temps de traitement pour modifier les 16 produits (nom, euro, centime) correspond à 48 appelle de la procédure (48 champs à changer).

Cette étape prend environ 13 minutes. C'est beaucoup trop pour l'utilisateur qui veux seulement imprimer son fichier.

Avez vous une idée pour réduire le temps d'attente ?


Merci

[StringBuilder]

Vire le On Error Resume Next (ça existe encore ça ?)

Aussi, les fichiers font quelle taille ?
Y'en a beaucoup ?

L'algo en lui-même m'a l'air tout à fait bon, et ne devrait pas être lent... à moins qu'il soit appelé des centaines de fois en même temps...

[StringBuilder]

Hmmmm... Au temps pour moi !

Tu appelles trois fois de suite ce truc pour chaque fiche produit ?

Pourquoi ne pas passer un "string[] strOld, string[] strNew" en paramètre, et faire une boucle sur les paramètres dans ton sub ?

Ca évitera de recopier 3 fois de suite ton fichier !

Aussi, si ton fichier est petit, au lieu de faire le traitement ligne par ligne, tu peux faire un ReadAll plutôt qu'un ReadLine pour charger tous le fichier d'un coup, et faire tes replaces dessus.

[Soyanlo]

Merci pour la réponse !

Le fichier a une taille d'environ 70 000ko.

L'idée d'envoyer un tableau me plais bien mais je ne voie pas comment modifier le corps de la procédure...

Juste dans le DO qu'il faut faire une modif ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Do While Not EOF(nIn)
            Dim strLigne = LineInput(nIn)
            strLigne = Replace(strLigne, strOldString, strNewString)
            PrintLine(nOut, strLigne)
        Loop

Juste rajouter une ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

strLigne = Replace(strLigne, strOldString, strNewString)

Pour chaque chaine à changer ?

[StringBuilder]

Dans le do, tu dois boucler sur ton tableau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
for i = lbound(strOldString) to ubound(strOldString)
   strLigne = Replace(strLigne, strOldString(i), strNewString(i))
next

[Soyanlo]

J'ai tenter de mettre ceci :

La procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub ReplaceString(ByVal strFichier, ByVal strOldString, ByVal strNewString)
        On Error Resume Next
 
        Dim strTemp = Application.StartupPath & "\File.tmp"
 
        Dim nIn = FreeFile()
        FileOpen(nIn, strFichier, OpenMode.Input)
 
        Dim nOut = FreeFile()
        FileOpen(nOut, strTemp, OpenMode.Output)
 
        Do While Not EOF(nIn)
            Dim strLigne = LineInput(nIn)
            For i = LBound(strOldString) To UBound(strOldString)
                strLigne = Replace(strLigne, strOldString(i), strNewString(i))
            Next
            PrintLine(nOut, strLigne)
        Loop
 
        FileClose(nOut)
        FileClose(nIn)
 
        FileCopy(strTemp, strFichier)
        Kill(strTemp)
 
    End Sub

Et pour tester j'ai mis ceci dans le corps du programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
 
 
        If Mode.Text = "Ajout" Then
            Dim strFile = Dir(Application.StartupPath & "\Output\" & txtnom.Text & ".rep")
            Dim nomfic As String
            Dim vérif As Integer
            Dim Montableau1(3) As String
            Dim Montableau2(3) As String
 
                    FileCopy(Application.StartupPath & "\Templates\Template_feuille.rep", Application.StartupPath & "\Output\" & nomfic & ".rep")
                    Montableau1(1) = "<%item_01%>"
                    Montableau1(2) = "<%prix_01%>"
                    Montableau1(3) = "<%cent_01%>"
                    Montableau2(1) = MaskedTextBox1.Text
                    Montableau2(2) = MaskedTextBox2.Text
                    If MaskedTextBox3.Text <> "" Then
                        Montableau2(3) = "." & MaskedTextBox3.Text & "€"
                    Else
                        Montableau2(3) = ""
                    End If
                    ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", Montableau1(3), Montableau2(3))

Mais juste pour cet exemple (seulement 3 chaines à remplacer) le programme tourne depuis plusieurs minutes... je doit avoir loupé un truc...

[Soyanlo]

Je viens de tester comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 Do While Not EOF(nIn)
            MsgBox(5)
            Dim strLigne = LineInput(nIn)
            strLigne = Replace(strLigne, strOldString(1), strNewString(1))
            MsgBox(6)
            strLigne = Replace(strLigne, strOldString(2), strNewString(2))
            MsgBox(7)
            strLigne = Replace(strLigne, strOldString(3), strNewString(3))
            MsgBox(8)
            PrintLine(nOut, strLigne)
            MsgBox(9)
        Loop

Et il boucle sans fin en passant par toutes les étapes

[StringBuilder]

Le but du jeu, c'est de lancer une et une seule fois ton StringReplace, en passant en paramètre les deux tableaux entiers.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", Montableau1, Montableau2)

[StringBuilder]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Sub ReplaceString(ByVal strFichier, ByVal strOldString, ByVal strNewString)
        Dim i As Integer
        Dim strTemp = Application.StartupPath & "\File.tmp"
 
        Dim nIn = FreeFile()
        FileOpen(nIn, strFichier, OpenMode.Input)
 
        Dim nOut = FreeFile()
        FileOpen(nOut, strTemp, OpenMode.Output)
 
        Do While Not EOF(nIn)
            Dim strLigne = LineInput(nIn)
            For i = LBound(strOldString) To UBound(strOldString)
                strLigne = Replace(strLigne, strOldString(i), strNewString(i))
            Next
            PrintLine(nOut, strLigne)
        Loop
 
        FileClose(nOut)
        FileClose(nIn)
 
        FileCopy(strTemp, strFichier)
        Kill(strTemp)
End Sub

Puis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
 
 
        If Mode.Text = "Ajout" Then
            Dim strFile = Dir(Application.StartupPath & "\Output\" & txtnom.Text & ".rep")
            Dim nomfic As String
            Dim vérif As Integer
            Dim Montableau1(3) As String
            Dim Montableau2(3) As String
 
                    FileCopy(Application.StartupPath & "\Templates\Template_feuille.rep", Application.StartupPath & "\Output\" & nomfic & ".rep")
                    Montableau1(1) = "<%item_01%>"
                    Montableau1(2) = "<%prix_01%>"
                    Montableau1(3) = "<%cent_01%>"
                    Montableau2(1) = MaskedTextBox1.Text
                    Montableau2(2) = MaskedTextBox2.Text
                    If MaskedTextBox3.Text <> "" Then
                        Montableau2(3) = "." & MaskedTextBox3.Text & "€"
                    Else
                        Montableau2(3) = ""
                    End If
                    ReplaceString(Application.StartupPath & "\Output\" & nomfic & ".rep", Montableau1, Montableau2)
     End If
End Sub

[Soyanlo]

Merci beaucoup ça fonctionne

Je vais pouvoir faire différents essais merci !!!!

Après les testes, de 13 minutes, l'enregistrement passe à environ 3 minutes

Merci infiniment