Discussion :

[Fionac]

Bonjour,

J'ai une macro me permettant d'extraire (depuis un format fdf) les commentaires de documents PDF à partir d'un bouton. A chaque fois que je clique sur le bouton les extractions des essaies précédents sont supprimées. Je voudrais que les commentaires de chaque extraction soient conservées. Pouvez-vous m'aider?

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
164
165
166
167
168
169
170
171
172
173
Dim Initials As String
Dim nom As String
Dim dpt As String
Sub PDF_Parse(Filename As String)
    On Error Resume Next
 
    Dim Ligne As String
    Dim num As Long
    I = 0
    debut = 26
 
    'ouvre le fichier en lecture
    num = FreeFile
    Open Filename For Input As #num
 
    'boucle tant que l'on n'a pas atteint la fin du fichier
    lin = 1
    While Not EOF(num)
 
        Line Input #num, UneLigne
        Obj = Right(UneLigne, 4)
        If Obj = " obj" Then
            Ligne = ""
            Do While Not EOF(num)
                Line Input #num, UneLigne
                Ligne = Ligne + UneLigne
                If UneLigne = "endobj" Then
                    Exit Do
                End If
            Loop
 
            idebContent = InStr(Ligne, "/Contents(")
            ifinContent = WorksheetFunction.Max(InStr(WorksheetFunction.Max(idebContent, 1), Ligne, ")/F"), idebContent)
            ifinContent = InStr(WorksheetFunction.Max(idebContent, 1), Ligne, ")/F")
 
 
            idebPage = InStr(WorksheetFunction.Max(ifinContent, 1), Ligne, "/Page")
            ifinPage = WorksheetFunction.Max(InStr(WorksheetFunction.Max(idebPage, 1) + 2, Ligne, "/"), idebPage)
            sContent = ""
            If (idebContent) Then
                sContent = Mid(Ligne, idebContent + 10, ifinContent - idebContent - 10)
                sContent = Replace(sContent, "\r", Chr(10))
            End If
            sPage = ""
            Dim iPage As Integer
            If (idebPage) Then
                iPage = Mid(Ligne, idebPage + 2 + 4, ifinPage - idebPage - 2 - 4) + 1
                sPage = "Page " & iPage
            End If
            If (idebContent) Then
                ThisWorkbook.Sheets("Remarks").Cells(I + debut, 1) = I + 1
 
        ThisWorkbook.Sheets("Remarks").Cells(I + debut, 14) = Date
        ThisWorkbook.Sheets("Remarks").Cells(I + debut, 13) = nom
        ThisWorkbook.Sheets("Remarks").Cells(I + debut, 15) = dpt
                ThisWorkbook.Sheets("Remarks").Cells(I + debut, 3) = sPage
ThisWorkbook.Sheets("Report").Cells(7, 14) = iPage
 
'Type and text of revision
 
If (LCase(Left(sContent, 6)) = "major ") Or (LCase(Left(sContent, 6)) = "Major ") Or (LCase(Left(sContent, 4)) = "Maj ") Or (LCase(Left(sContent, 4)) = "maj ") Then
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 9) = "Major"
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 5) = Mid(sContent, 1)
                ElseIf (LCase(Left(sContent, 6)) = "minor ") Or (LCase(Left(sContent, 6)) = "Minor ") Or (LCase(Left(sContent, 4)) = "Min ") Or (LCase(Left(sContent, 4)) = "min ") Then
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 9) = "Minor"
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 5) = Mid(sContent, 1)
                ElseIf (LCase(Left(sContent, 8)) = "blocked ") Or (LCase(Left(sContent, 8)) = "Blocked ") Or (LCase(Left(sContent, 6)) = "block ") Or (LCase(Left(sContent, 6)) = "Block ") Then
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 9) = "Blocked"
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 5) = Mid(sContent, 1)
                ElseIf (LCase(Left(sContent, 10)) = "not error ") Or (LCase(Left(sContent, 10)) = "Not error ") Or (LCase(Left(sContent, 3)) = "NE ") Or (LCase(Left(sContent, 3)) = "ne ") Then
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 9) = "Not error"
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 5) = Mid(sContent, 1)
                Else
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 9) = " "
                    ThisWorkbook.Sheets("Remarks").Cells(I + debut, 5) = Mid(sContent, 1)
        End If
 
 
        'Defect class
 
    If InStr(1, sContent, "Accuracy", vbTextCompare) <> 0 Or InStr(1, sContent, "accuracy", vbTextCompare) <> 0 Or InStr(1, sContent, "Acc", vbTextCompare) <> 0 Or InStr(1, sContent, "acc", vbTextCompare) <> 0 Then
             ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Accuracy"
 
        ElseIf InStr(1, sContent, "Clarity", vbTextCompare) <> 0 Or InStr(1, sContent, "clarity", vbTextCompare) <> 0 Or InStr(1, sContent, "Cla", vbTextCompare) <> 0 Or InStr(1, sContent, "cla", vbTextCompare) <> 0 Then
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Clarity"
 
        ElseIf InStr(1, sContent, "Completness", vbTextCompare) <> 0 Or InStr(1, sContent, "completness", vbTextCompare) <> 0 Or InStr(1, sContent, "Complet", vbTextCompare) <> 0 Or InStr(1, sContent, "complet", vbTextCompare) <> 0 Then
             ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Completeness"
 
        ElseIf InStr(1, sContent, "Compliance", vbTextCompare) <> 0 Or InStr(1, sContent, "compliance", vbTextCompare) <> 0 Or InStr(1, sContent, "Compli", vbTextCompare) <> 0 Or InStr(1, sContent, "compli", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Compliance"
 
        ElseIf InStr(1, sContent, "Consistency", vbTextCompare) <> 0 Or InStr(1, sContent, "consistency", vbTextCompare) <> 0 Or InStr(1, sContent, "Cons", vbTextCompare) <> 0 Or InStr(1, sContent, "cons", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Consistency"
 
        ElseIf InStr(1, sContent, "Correctness", vbTextCompare) <> 0 Or InStr(1, sContent, "correctness", vbTextCompare) <> 0 Or InStr(1, sContent, "Corr", vbTextCompare) <> 0 Or InStr(1, sContent, "corr", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Correctness"
 
        ElseIf InStr(1, sContent, "Drafting", vbTextCompare) <> 0 Or InStr(1, sContent, "drafting", vbTextCompare) <> 0 Or InStr(1, sContent, "Dra", vbTextCompare) <> 0 Or InStr(1, sContent, "dra", vbTextCompare) <> 0 Then
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Drafting"
 
         ElseIf InStr(1, sContent, "Formalism", vbTextCompare) <> 0 Or InStr(1, sContent, "formalism", vbTextCompare) <> 0 Or InStr(1, sContent, "Form", vbTextCompare) <> 0 Or InStr(1, sContent, "form", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Formalism"
 
         ElseIf InStr(1, sContent, "Legibility", vbTextCompare) <> 0 Or InStr(1, sContent, "legibility", vbTextCompare) <> 0 Or InStr(1, sContent, "Legi", vbTextCompare) <> 0 Or InStr(1, sContent, "legi", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Legibility"
 
        ElseIf InStr(1, sContent, "Missing", vbTextCompare) <> 0 Or InStr(1, sContent, "missing", vbTextCompare) <> 0 Or InStr(1, sContent, "Miss", vbTextCompare) <> 0 Or InStr(1, sContent, "miss", vbTextCompare) <> 0 Then
           ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Missing"
 
        ElseIf InStr(1, sContent, "Maintainability", vbTextCompare) <> 0 Or InStr(1, sContent, "maintainability", vbTextCompare) <> 0 Or InStr(1, sContent, "Maint", vbTextCompare) <> 0 Or InStr(1, sContent, "maint", vbTextCompare) <> 0 Then
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Maintainability"
 
            ElseIf InStr(1, sContent, "Testability", vbTextCompare) <> 0 Or InStr(1, sContent, "testability", vbTextCompare) <> 0 Or InStr(1, sContent, "Test", vbTextCompare) <> 0 Or InStr(1, sContent, "test", vbTextCompare) <> 0 Then
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Testability"
 
            ElseIf InStr(1, sContent, "Traceability", vbTextCompare) <> 0 Or InStr(1, sContent, "traceability", vbTextCompare) <> 0 Or InStr(1, sContent, "Trac", vbTextCompare) <> 0 Or InStr(1, sContent, "trac", vbTextCompare) <> 0 Then
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = "Traceability"
 
        Else
            ThisWorkbook.Sheets("Remarks").Cells(I + debut, 8) = " "
 
        End If
 
                I = I + 1
            End If
 
            lin = lin + 1
        End If
 
    Wend
    Close #num 'fermeture
 
End Sub
 
 
Sub PDF_Choose()
 
Dim STRArray() As String
 
 
    On Error Resume Next
    ' Selection du document
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    DocName = Application.GetOpenFilename(Title:="Choisir le fichier de commentaires exporté", FileFilter:="Fichiers commentaires fdf *.fdf (*.fdf),")
    If DocName = False Then Exit Sub
 
    Application.ScreenUpdating = False
 
    Load ProofReader
    ProofReader.Show
 
'boucle for por report
 
    ThisWorkbook.Sheets("Report").Cells(22, 1) = ProofReader.nom & " " & ProofReader.prenom
    nom = ProofReader.nom
    ThisWorkbook.Sheets("Report").Cells(22, 6) = ProofReader.dpt
  dpt = ProofReader.dpt
 
   Unload ProofReader
 
    ' Recovery
    PDF_Parse (DocName)
 
    STRArray = Split(DocName, ".")
 
    extension = ".xlsx"
    FileSaveName = Application.GetSaveAsFilename(InitialFileName:=STRArray(0) & "_" & Initials & "_Comments_" & Format(Date, "dd") & Format(Date, "mm") & Format(Date, "yy") & extension, FileFilter:="Excel Sheet (*.xlsx), *.xlsx")
      If FileSaveName <> False Then
            ThisWorkbook.SaveAs Filename:=FileSaveName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      End If
End Sub

[Pierre Fauconnier]

Salut.

Tout le code d'extraction n'était pas nécessaire, à mon avis


je n'ai évidemment pas tester un code pareil, mais apparemment, tu n'as pas déclaré tes variables et les noms sont ambigus. Je trouve par exemple un Lin qui n'est pas déclaré. Sans déclarer tes variables, tu vas avoir des soucis si tu les orthographies mal dans la suite du code, car VBA va utiliser ce que tu lui donnes sans vérifier que ça existe, et il va initialiser ce qui n'est pas déclaré avec la valeur par défaut (0 pour une variable numérique). De plus, tu as un On Error Resume Next qui n'amène aucune gestion d'erreur par la suite, de sorte que si une erreur survient, elle est simplement ignorée et va probablement amener d'autres erreurs en cascade.

Normalement, on essaie de découper son code pour s'y retrouver et d'écrire des procédures/fonctions qui n'ont qu'une seule responsabilité (une fonction pour récupérer le pdf, une fonction pour récupérer les commentaires, une fonction pour écrire les commentaires dans une feuille Excel, etc). Ici, tout est mélangé de sorte qu'il est plus que malaisé de s'y retrouver.

Tu devrais pouvoir exécuter ce code pas-à-pas pour visualiser chaque ligne, voir laquelle écrit dans la feuille Excel et tu pourras alors déterminer où commencer à écrire (à la suite de ce qui existe déjà sur la feuille). Ici, sans même voir à quoi ressemble ta feuille Excel et sans la volonté de lire tout ton code pour trouver où on commence à écrire, c'est un peu compliqué.


Je peux toutefois émettre l'idée que le problème vient de la ligne qui affecte 26 à la variable Début. Ca veut dire que l'écriture dans la feuille va commencer à la ligne 26. Peut-être pourrais-tu essayer de la remplacer par:

Code :

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

Début = ThisWorkbook.Sheets("Remarks").Cells(1048576,1).End(xlUp).Row+1

Tu initialises I à 0, puis tu ajoutes Début à I... ThisWorkbook.Sheets("Remarks").Cells(I + Début, ...). Tu pourrais utiliser ThisWorkbook.Sheets("Remarks").Cells(Début, ...) (Début + 0 = Début, non?)

Pour rendre ton code plus lisible, tu aurais intérêt à utiliser une variable qui pointe vers ta feuille

Code :

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

1
2
3
dim Feuillecible as Worksheet
 
set feuillecible = ThisWorkbook.Sheets("Remarks")

Ca permettra par la suite d'utiliser feuillecible.cells(début, ...) = ....

Perso, je travaillerais avec un tableau structuré pour récupérer les commentaires.J'éviterais le Exit Do (je déteste les Exit), etc...