Besoin d'explication sur un script

**DjiLow** · 18/01/2010, 11h50

Bonjour je viens vers vous car je n'ai aucune notion en visual basic
Je travaille actuellement sur un projet dans lequel je reprend la suite d'un collègue.
Il a écrit des scripts qui génère des fichiers .csv
J'aurais besoin de comprendre son script afin de pouvoir travailler dessus.

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Sub ibnf()
' A partir d'un répertoire, Prendre tous les fichiers .ri
' Compter les sortes de cartes
    Const ligneinit As Integer = 4
   Dim SN As String
   Dim nom As String
 
 
    With Application.FileSearch
        compteur = 0
        .NewSearch
        .FileType = msoFileTypeWordDocuments
        .LookIn = ActiveWorkbook.Path
        .Filename = "*.ri"
        If .Execute() > 0 Then
            compteur = .FoundFiles.Count
        Else
            .NewSearch
 
            .FileType = msoFileTypeWordDocuments
            .Filename = "*.ri"
            Response = MsgBox("Le fichier excel n'est pas dans le répertoire des fichiers RI" _
                              & Chr(10) & "Rechercher un fichier .ri", _
                              vbYesNo, "RECHERCHE FICHIER")
            CurDir ActiveWorkbook.Path
            If Response = vbNo Then
                Exit Sub
            End If
            Nom_complet = .Application.GetOpenFilename("Text Files (*.ri), *.txt")
            ' Nom complet où les infos brutes se situent
 
            If Nom_complet = False Then
                Exit Sub
            End If
 
            rep = CherRep(Nom_complet)
            If rep <> "" Then
                .LookIn = rep
                If .Execute() > 0 Then
                    compteur = .FoundFiles.Count
                Else
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
        End If
 
        ' Vider le précédent comptage
        nbligne = ActiveSheet.UsedRange.Rows(1).Row + _
                  ActiveSheet.UsedRange.Rows.Count - 1
        If ligneinit <= nbligne Then
            Rows(ligneinit & ":" & nbligne).Delete Shift:=xlShiftUp
        End If
        If ligneinit > 1 Then
            nbligne = ligneinit - 1
        Else
            nbligne = 0
        End If
        ActiveSheet.Cells(1, 2).Value = compteur
 
        ' commencer à compter
        Set fs = CreateObject("Scripting.FileSystemObject")
        For num = 1 To compteur
            Set fichier = fs.OpenTextFile(.FoundFiles(num))
            Do While fichier.AtEndOfStream <> True
                laligne = Trim(fichier.ReadLine)
                If laligne <> "" Then
                    If InStr(1, laligne, "USER LABEL          :") = 1 Then
                        longueur = InStr(laligne, ":")
                        longueur2 = InStr(laligne, "/")
                        UserLabel = Trim(Mid(laligne, longueur + 2, longueur2 - longueur - 2))
                        emplacemt = Trim(Mid(laligne, longueur2))
                    ElseIf InStr(1, laligne, "Unit type :") = 1 Then
                        LeType = Trim(Right(laligne, Len(laligne) - 11))
                    ElseIf InStr(1, laligne, "Unit part number : 3") = 1 Then
                            Code = Trim(Mid(laligne, Len(laligne) - 14, 11))
                            Indice = Trim(Right(laligne, 4))
                    ElseIf InStr(1, laligne, "Unit part number : 1") = 1 Then
                            lecode = Trim(Right(laligne, Len(laligne) - 18))
                            If Len(lecode) = "12" Then
                            Code = Trim(Right(laligne, Len(laligne) - 18))
                            Indice = ""
                            Else
                            Code = Trim(Mid(laligne, Len(laligne) - 14, 13))
                            Indice = Trim(Right(laligne, 2))
                            End If
                    ElseIf InStr(1, laligne, "Serial number :") = 1 Then
                        SN = Trim(UCase(Right(laligne, Len(laligne) - 15)))
                    ElseIf InStr(1, laligne, "Date (") = 1 Then
                        DateManu = Format(Trim(Right(laligne, Len(laligne) - 11)), "yy/mm/dd")
                        'If (InStr(1, Code, "3AL94207") = 1) Or _
                        '   (InStr(1, Code, "3AL94452") = 1) Then
                            nbligne = nbligne + 1
                            Cells(nbligne, 1) = emplacemt
                            Cells(nbligne, 2) = UserLabel
                            Cells(nbligne, 4) = LeType
                            Cells(nbligne, 5) = Code
                            Cells(nbligne, 6) = Indice
                            Cells(nbligne, 7) = SN
                            Cells(nbligne, 8).Formula = Format(DateManu, "dd-mm-yyyy")
                        'End If
                    End If
                End If
            Loop
 
            '************* Fermeture du fichier des infos brutes **********
            fichier.Close
        Next num
        Set fs = Nothing
    End With
    Rows("1:3").Delete Shift:=xlShiftUp
    ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\Administrateur\Bureau\MAJ 04012010\IBN-F\rmcsr\ibnf.csv", FileFormat:=xlCSV, CreateBackup:=False
 
End Sub
 
Private Function CherRep(ByVal Nom_complet As String) As String
    For pos = Len(Nom_complet) To 1 Step -1
        If Mid(Nom_complet, pos, 1) = "\" Then
            Exit For
        End If
    Next pos
    If pos = 0 Then
        CherRep = ""
        Exit Function
    End If
 
    CherRep = Left(Nom_complet, pos) ' Répertoire des infos brutes
End Function

Si quelqu'un aurait la gentilesse de me commenter son script afin que j'en comprenne le fonctionnement.
Merci d'avance

**Gorfael** · 27/01/2010, 21h04

Salut DjiLow et le forum
Comme personne ne t'a répondu, j'ai unpeu commenté le code

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Sub ibnf()
' A partir d'un répertoire, Prendre tous les fichiers .ri
' Compter les sortes de cartes
Const ligneinit As Integer = 4
Dim SN As String
Dim nom As String
With Application.FileSearch
'Mettre Application.FileSearch en préfixe
    compteur = 0
    'variable compteur (?) à 0
    .NewSearch
    'Nouvelle recherche (Application.FileSearch.NewSearch)
    .FileType = msoFileTypeWordDocuments
    'Type de fichier = document word
    .LookIn = ActiveWorkbook.Path
    'où regarder = dansle répertoire du classeur actif
    .Filename = "*.ri"
    'nom = tous les fichiers d'extension ri
    If .Execute() > 0 Then
    'si la recherche retourne au moins un fichier, alors
        compteur = .FoundFiles.Count
        'compteur = nombre de fichiers de la recherche
    Else
    'sinon
        .NewSearch
        'Lancer une nouvelle recherche
        .FileType = msoFileTypeWordDocuments
        .Filename = "*.ri"
        Response = MsgBox("Le fichier excel n'est pas dans le répertoire des fichiers RI" _
                           & Chr(10) & "Rechercher un fichier .ri", vbYesNo, "RECHERCHE FICHIER")
        'reponse = retour de la boîte de dialogue (oui/non)
        CurDir ActiveWorkbook.Path
        'répertoire courant = répertoire où se situe le classeur actif
        If Response = vbNo Then
        'Reponse = non alors
            Exit Sub
            'terminer la macro (sortir)
        End If
        Nom_complet = .Application.GetOpenFilename("Text Files (*.ri), *.txt")
        ' Nom complet où les infos brutes se situent
        'ouvre la boîte de dialogue "Ouvrir"
 
        If Nom_complet = False Then
        'si le fichier à ouvrir n'existe pas
            Exit Sub
            'sortir
        End If
 
        rep = CherRep(Nom_complet)
        'rep = retour de la fonction CherRep, avec Nom_complet comme argument
        If rep <> "" Then
        'si rep n'est pas vide, alors
            .LookIn = rep
            'la recherche se fera dans le répertoire rep
            If .Execute() > 0 Then
            'si la recherche retour au moins un fichier
                compteur = .FoundFiles.Count
                'compteur = nombre de fichiers trouvé
            Else
            'sinon
                Exit Sub
                'sortir
            End If
        Else
        'sinon (rep vide)
            Exit Sub
            'sortir
        End If
    End If
 
    ' Vider le précédent comptage
    nbligne = ActiveSheet.UsedRange.Rows(1).Row + ActiveSheet.UsedRange.Rows.Count - 1
    'nbligne = pour la plage de travail de la feuille active (numéro de la 1ère ligne + nombre de lignes -1
    If ligneinit <= nbligne Then
    'si nbligne=>4, alors
        Rows(ligneinit & ":" & nbligne).Delete Shift:=xlShiftUp
        'supprimer les lignes à partir de la 4ème jusqu'à la dernière
    End If
    If ligneinit > 1 Then
    'si ligneinit>1 alors *********************
        nbligne = ligneinit - 1
    Else
        nbligne = 0
    End If
    ActiveSheet.Cells(1, 2).Value = compteur
 
    ' commencer à compter
    Set fs = CreateObject("Scripting.FileSystemObject")
    For num = 1 To compteur
        Set fichier = fs.OpenTextFile(.FoundFiles(num))
        Do While fichier.AtEndOfStream <> True
            laligne = Trim(fichier.ReadLine)
            If laligne <> "" Then
                If InStr(1, laligne, "USER LABEL          :") = 1 Then
                    longueur = InStr(laligne, ":")
                    longueur2 = InStr(laligne, "/")
                    UserLabel = Trim(Mid(laligne, longueur + 2, longueur2 - longueur - 2))
                    emplacemt = Trim(Mid(laligne, longueur2))
                ElseIf InStr(1, laligne, "Unit type :") = 1 Then
                    LeType = Trim(Right(laligne, Len(laligne) - 11))
                ElseIf InStr(1, laligne, "Unit part number : 3") = 1 Then
                        Code = Trim(Mid(laligne, Len(laligne) - 14, 11))
                        Indice = Trim(Right(laligne, 4))
                ElseIf InStr(1, laligne, "Unit part number : 1") = 1 Then
                        lecode = Trim(Right(laligne, Len(laligne) - 18))
                        If Len(lecode) = "12" Then
                        Code = Trim(Right(laligne, Len(laligne) - 18))
                        Indice = ""
                        Else
                        Code = Trim(Mid(laligne, Len(laligne) - 14, 13))
                        Indice = Trim(Right(laligne, 2))
                        End If
                ElseIf InStr(1, laligne, "Serial number :") = 1 Then
                    SN = Trim(UCase(Right(laligne, Len(laligne) - 15)))
                ElseIf InStr(1, laligne, "Date (") = 1 Then
                    DateManu = Format(Trim(Right(laligne, Len(laligne) - 11)), "yy/mm/dd")
                    'If (InStr(1, Code, "3AL94207") = 1) Or _
                    '   (InStr(1, Code, "3AL94452") = 1) Then
                        nbligne = nbligne + 1
                        Cells(nbligne, 1) = emplacemt
                        Cells(nbligne, 2) = UserLabel
                        Cells(nbligne, 4) = LeType
                        Cells(nbligne, 5) = Code
                        Cells(nbligne, 6) = Indice
                        Cells(nbligne, 7) = SN
                        Cells(nbligne, 8).Formula = Format(DateManu, "dd-mm-yyyy")
                    'End If
                End If
            End If
        Loop
 
        '************* Fermeture du fichier des infos brutes **********
        fichier.Close
    Next num
    Set fs = Nothing
End With
Rows("1:3").Delete Shift:=xlShiftUp
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\Administrateur\Bureau\MAJ 04012010\IBN-F\rmcsr\ibnf.csv", FileFormat:=xlCSV, CreateBackup:=False
 
End Sub
 
Private Function CherRep(ByVal Nom_complet As String) As String
'Reçoit lavariable chaîne Nom_Complet
'Retourne la variable chaîne CherRep
    For pos = Len(Nom_complet) To 1 Step -1
    'Pour Pos = Longueur(Nom_Complet) jusqu'à 1 en enlevant 1
        If Mid(Nom_complet, pos, 1) = "\" Then
        'si la lettre n°pos = "\" alors
            Exit For
            'Sortir de la boucle
        End If
    Next pos
    'Pos suivant (précédent)
    If pos = 0 Then
    'si Pos = 0, alors
        CherRep = ""
        'CherRep = vide
        Exit Function
        'Sortir
    End If
    CherRep = Left(Nom_complet, pos) ' Répertoire des infos brutes
    'CherRep = le chemin complet, jusqu'au dernier \
End Function

Je me suis arrêté sur la ligne où j'ai mis "*******".
Déjà que le code me semble étrange (mais je n'utilise pas ce style de commande), mais là, il devient débile : Je fixe une constante à 4 et je vérifie si cette variable est supérieure à 1 ? Quelque chose doit m'échapper.
A+

**DjiLow** · 28/01/2010, 08h53

En tout cas merci Gorfael d'avoir pris un peu de temps pour répondre à ma demande. Je vois un peu plus claire dans ce morceau de macro grâce à toi.
En revanche pour ce qui est de la qualité de celle-ci j'en suis désolé mais à ce niveau là je reprend le travail d'un ancien employé.
Je vais tâcher de creuser un peu plus afin de comprendre parfaitement les macros Excel et ainsi peu être y apporté des modifications
Encore merci

**Gorfael** · 28/01/2010, 12h36

Salut DjiLow et le forum
Reprendre une macro comme celle-ci n'est pas forcément la bonne solution : Les besoins ont pu évoluer, et la méthode de travail de celui/ceux qui l'utlisent n'est plus obligatoirement identique.

Reprendre une macro, seulement à partir du code et de ses effets, demande une bonne connaissance du VBA.

Crées-toi un répertoire d'essai, et travailles avec un ou deux fichiers ".ri" de 2 ou 3 lignes.
Tu mets un point d'arrêt sur la ligne de titre de la macro et tu avance Pas-à-pas avec [F8]. Ça te permet de regarder le contenu des différentes variables à chaque ligne de code et ce qu'elle fait (j'utilise la fenêtre variables Locales).
Ça devrait te permettre de comprendre son algorithme, de le simplifier et de recréer la macro, en te servant des mêmes instructions. Deux avantages : ta macro devrait devenir plus simple, et tu devrais la maîtriser complètement.
A+

**DjiLow** · 29/01/2010, 10h45

Je vais suivre ton conseil Gorfael
Merci à toi et bonne continuation

Besoin d'explication sur un script

Macros et VBA Excel

Discussions similaires

Partager

Partager