Discussion :

[jmahe]

Bonjour le forum,
Cela fait des mois que je m'aide de vos super post pour m'aider en VBA. J'ai appris en autodidacte surtout grâce à vous! Pour la première fois je n'ai pas trouvé la solution dans les post déjà existant donc j'écris ma première contribution.

Dans mon entreprise je dois "transformer" tout un répertoire de fiches outils sur word (1 word pour 1 référence (600 références ) en une seul base de donnée excel. Du coup, avant de coder les outils de gestions de la BdD je voudrais tout copier en automatique.

Le problème est le suivant:

A des moments aléatoires, sur les lignes qui font mon pastespecial (pas toujours la même) dans les trois boucle if en cascade j'ai une "erreur 1004 : la méthode pastespecial de la classe range à échoué"

Le fait que cela survienne de manière inopiné me bloque, je vois pas du tout comment identifier l'erreur...

Pour info je me suis basé sur cet exemple : http://www.gcexcel.com/vba-importer-...rd-vers-excel/

Votre aide serait la bienvenue

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
 
Sub Importation_Donnees_Word()
 
    ' -- Déclaration des variables
    Dim wb As Workbook          'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
    Dim sChemin As String       'répertoire contenant les fichiers Word
    Dim sNomFichier As String   'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object
    Dim i As Integer
    Dim PG As Long
 
    Dim REF As String
    Dim M As String
    Dim P As String
    Dim IND As String
    Dim x As Integer
 
    Dim DerLW As Integer
    Dim L As Integer
    Dim C As Integer
    Dim CoWo As Integer
    Dim ii As Integer
 
    Dim TEST
 
    Dim tempsdebut As Date, tempsfin As Date, tempschrono As Date
    tempsdebut = Time()
 
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = "\\SRV-DATA\Commun\METHODES\Fraisage\FO\"          'fonction pour choisir le répertoire contenant les fichier Word
    'sChemin = ThisWorkbook.Path & "\"           'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
    sNomFichier = Dir(sChemin & "*.doc*")       'pour ouvrir tous les fichiers .doc*. 1er fichier.
 
    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = False                      'ne pas afficher Word pendant l'exécution
    i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1   '1re ligne où on va écrire les données dans le fichier Excel
 
    Application.ScreenUpdating = False
 
 
    ' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0
 
'If i > 12 Then '/!\ pour le développement : limite le temps des tests
    'GoTo SortieNormale
'End If
 
 
        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier, ReadOnly:=True)   'ouvre le document Word
        PG = i * 0.19
        Application.StatusBar = "Avancement importation : " & PG & "%"       'message dans Excel pour voir la progression
 
        'Références
        REF = Mid(sNomFichier, 4)
        x = InStr(1, REF, "-W", 1) - 1
        If x = -1 Then
            x = InStr(1, REF, "-V", 1) - 1
            If x = -1 Then
                x = InStr(1, REF, "-H", 1) - 1
            End If
        End If
 
        REF = Left(REF, x)
        ws.Cells(i, 1) = REF
 
        'Machine
        x = InStr(1, sNomFichier, "-WM", 1) + 1
        If x = 1 Then
            x = InStr(1, sNomFichier, "-VC") + 1
            If x = 1 Then
                x = InStr(1, sNomFichier, "-HS") + 1
            End If
        End If
 
        M = Mid(sNomFichier, x)
        x = InStr(1, M, "-") - 1
        M = Left(M, x)
 
        ws.Cells(i, 2) = M
 
        'Palettisation
        x = InStr(1, sNomFichier, "-IT", 1) + 1
        If x = 1 Then
            P = ""
            GoTo suite
        End If
 
        P = Mid(sNomFichier, x)
        x = InStr(1, P, "-") - 1
        P = Left(P, x)
suite:
        ws.Cells(i, 3) = P
 
        'Indice
        x = InStr(1, sNomFichier, "-ind", 1) + 4
 
        IND = Mid(sNomFichier, x)
        x = InStr(1, IND, ".") - 1
        IND = Left(IND, x)
 
        ws.Cells(i, 4) = IND
 
        'Extraction du tableau 1 de chaque FO
        DerLW = WDoc.Tables(1).Rows.Count
 
For CoWo = 1 To 7
    ii = CoWo
 
    For L = 2 To DerLW
 
        WDoc.Tables(1).Cell(L, CoWo).Range.Copy      'copie la valeur dans le presse papier
        ws.Select                                    'bascule vers Excel
 
        If L = 2 Then
 
            C = ii + 4
            ws.Cells(i, C).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule
 
        Else
 
            If L = 3 Then
                C = C + 7
                ws.Cells(i, C).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule
            Else
                ii = C
                C = ii + 7
                ws.Cells(i, C).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule
            End If
 
        End If
        If ws.Cells(i, C) = "" Then
            GoTo QuandLtabVIDE
        End If
    Next L
 
QuandLtabVIDE:
 
Next CoWo
 
        i = i + 1                       'prochaine ligne
        WDoc.Close False                'fermer le document Word sans enregistrer
        sNomFichier = Dir               'prochain document
Loop
 
SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit                           'Fermer l'instance de Word
    Application.StatusBar = True      'Remise à zéro de la barre d'état
 
    tempsfin = Time()
    tempschrono = tempsfin - tempsdebut
    MsgBox tempschrono
 
End Sub

[Menhir]

Perso, quand je dois transférer des données entre Word et Excel, la plupart du temps je passe par l'intermédiaire d'une variable.

Donc, au lieu de :

Code :

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

1
2
3
4
        WDoc.Tables(1).Cell(L, CoWo).Range.Copy      'copie la valeur dans le presse papier
        ws.Select                                    'bascule vers Excel
        C = ii + 4
        ws.Cells(i, C).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule

J'écrirais :

Code :

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

1
2
3
        SVal = WDoc.Tables(1).Cell(L, CoWo).Range.Text
        C = ii + 4
        ws.Cells(i, C).Value = SVal

Avec SVal de type string.

Pas sûr que ça puisse résoudre ton problème mais tu ne risques rien à essayer.

[jmahe]

Bonne idée j'avais même pas pensé à passer par une variable, je vais essayer.

Sinon est-ce que quelqu'un sait si le réseau plutôt lent (de l'entreprise) ou l'ordi (mes CPU tourne à plus de 50% en permanence pendant la macro) peut engendrer de telles erreurs?
Un truc du genre la macro veux coller avant que l'ordi repasse sur excel? Je pense à ça parce que j'ai vu cet théorie sur plusieurs forum (beaucoup moins sérieux que celui-ci

[jmahe]

J'ai essayé ta solution sur quelques lignes et rien que la différence d’utilisation de mes CPU est dantesques! Je reste sous la barre des 10% je lancerai pour les 600 fichiers word ce soir, on verra bien.

Par contre cela colle bien les valeurs du tableau word mais avec un point noir à la fin de chaque chaine de caractère collée:



une idée pour ça?

[Menhir]

Par contre cela colle bien les valeurs du tableau word mais avec un point noir à la fin de chaque chaine de caractère collée:
une idée pour ça?

En fait, si tu analyses le contenu de la variable avec un Len(), tu verras qu'il n'y a pas 1 mais 2 caractères supplémentaire. Un plus du point, il y en a un autre "invisible".
C'est la façon qu'à Word de gérer les tableaux qui est la cause de ça.

La seule solution que je vois est de faire une étape intermédiaire de plus.
Quelque chose comme :

Code :

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

SVal = Left(SVal, Len(SVal) - 2)

[traersa]

J'avais eu un problème similaire et effectivement la solution que j'avais trouvé avait été de ralentir mon code vba avec la fonction wait ou sleep. J'avoue que je ne sais plus trop laquelle des deux c'était.
Je pense que le problème vient du fait que notre macro consomme beaucoup de mémoire...
Bon courage.

Traersa

[jmahe]

Bonjour,
J'ai codé les modifs expliqué plus haut et il semblerai que, grâce à vous, ma macro est stable

L'utilisation d'une variable mémoire au lieu du presse papier standard à tellement optimisé m'a macro qu'elle ne plante plus. La vitesse par word est passé de 18.6 secondes à 2.77 secondes

Merci à vous, je met le code opérationnel et commenté ci-après pour les prochains :

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
 
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
'-----------------------------------------------------------------
Sub Importation_Donnees_Word()
 
    ' -- Déclaration des variables
    Dim wb As Workbook          'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
    Dim sChemin As String       'répertoire contenant les fichiers Word
    Dim sNomFichier As String   'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object '
    Dim i As Integer 'N° de la première ligne excel
    Dim PG As Long 'Valeur pour calculé le % d'avancement de la macro (désactivé car screenupdating=false)
 
    Dim REF As String 'Variable pour la référence pièce tronqué dans le nom du fichier
    Dim M As String 'Variable pour le nom de la machine tronqué dans le nom du fichier
    Dim P As String 'Variable pour la palettisation tronqué dans le nom du fichier
    Dim IND As String 'Variable pour l'indice de la FO tronqué dans le nom du fichier
    Dim x As Integer ''Variable pour trouvé la position de la cible des 4 variables précédentes dans le nom du fichier
 
    Dim DerLW As Integer 'variable du nombre de ligne dans le tableau Word
    Dim L As Integer 'numéro de la ligne du tableau Word à copier
    Dim C As Integer 'numéro de la colonne Excel où coller Sval
    Dim CoWo As Integer 'numéro de la colone Word où copier Sval
    Dim ii As Integer 'valeur pour lier CoWo à C
    Dim Sval As String 'variable servant de presse-papier pendant chaque copier/coller
 
 
    Dim tempsdebut As Date, tempsfin As Date, tempschrono As Date 'Variables pour mesurer le temps d'éxecution
    tempsdebut = Time()
 
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook                                         'Défini le classeur
    Set ws = wb.Sheets(1)                                         'Défini la feuille
    'sChemin = "\\SRV-DATA\Commun\METHODES\Fraisage\FO\"          'fonction pour choisir le répertoire contenant les fichier Word
    sChemin = "C:\Users\jmahe\Desktop\FO\"                        'Repertoire local pour tester macro pdt le dévelopement
    sNomFichier = Dir(sChemin & "*.doc*")                         'pour ouvrir tous les fichiers .doc*. 1er fichier.
 
    Set WApp = CreateObject("Word.Application")                 'pour créer un objet Word
    WApp.Visible = False                                        'ne pas afficher Word pendant l'exécution
    i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1            '1re ligne où on va écrire les données dans le fichier Excel
 
    Application.ScreenUpdating = False                          'Suspend le rafraichissement de l'écran (optimisation Tcy)
 
 
    ' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0
 
'If i > 32 Then '/!\ pour le développement : limite le temps des tests 'Boucle pour limiter le nombre de bouclage pdt le développement
    'GoTo SortieNormale
'End If
 
 
        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier, ReadOnly:=True)   'ouvre le document Word
        'PG = i * 0.19
        'Application.StatusBar = "Avancement importation : " & PG & "%"       'message dans Excel pour voir la progression
 
        'Références
        REF = Mid(sNomFichier, 4)                             'Modification du nom du fichier pour trouver la référence pièce
        x = InStr(1, REF, "-W", 1) - 1
        If x = -1 Then
            x = InStr(1, REF, "-V", 1) - 1
            If x = -1 Then
                x = InStr(1, REF, "-H", 1) - 1
            End If
        End If
 
        REF = Left(REF, x)
        ws.Cells(i, 1) = REF
 
        'Machine
        x = InStr(1, sNomFichier, "-WM", 1) + 1                'Modification du nom du fichier pour trouver la machine en fonction de la marque
        If x = 1 Then
            x = InStr(1, sNomFichier, "-VC") + 1
            If x = 1 Then
                x = InStr(1, sNomFichier, "-HS") + 1
            End If
        End If
 
        M = Mid(sNomFichier, x)
        x = InStr(1, M, "-") - 1
        M = Left(M, x)
 
        ws.Cells(i, 2) = M
 
        'Palettisation
        x = InStr(1, sNomFichier, "-IT", 1) + 1                'Modification du nom du fichier pour trouver la référence de la palette
        If x = 1 Then
            P = ""
            GoTo suite
        End If
 
        P = Mid(sNomFichier, x)
        x = InStr(1, P, "-") - 1
        P = Left(P, x)
suite:
        ws.Cells(i, 3) = P
 
        'Indice
        x = InStr(1, sNomFichier, "-ind", 1) + 4               'Modification du nom du fichier pour trouver l'indice de la FO
 
        IND = Mid(sNomFichier, x)
        x = InStr(1, IND, ".") - 1
        IND = Left(IND, x)
 
        ws.Cells(i, 4) = IND
 
        'Extraction du tableau 1 de chaque FO
        DerLW = WDoc.Tables(1).Rows.Count                      'Mesure la taille du tableau word
 
For CoWo = 1 To 7
    ii = CoWo
 
    For L = 2 To DerLW
 
        Sval = WDoc.Tables(1).Cell(L, CoWo).Range.Text  'copie la valeur
        Sval = Left(Sval, Len(Sval) - 2)                'Suprimme les caractères "fantômes" non-désirés venant de Word
        ws.Select                                       'bascule vers Excel
 
        If L = 2 Then
 
            C = ii + 4                                  'Incrémente la colonne où copier Sval au premier collage
            ws.Cells(i, C).Value = Sval                 'Colle dans Excel
 
        Else
 
            If L = 3 Then
                C = C + 7                                'Incrémente la colonne où copier Sval au deuxième collage
                ws.Cells(i, C).Value = Sval              'Colle dans Excel
            Else
                ii = C                                   'Incrémente la colonne où copier Sval à partir du 3ème collage
                C = ii + 7                               'gestion de l'incrément
                ws.Cells(i, C).Value = Sval              'Colle dans Excel
            End If
 
        End If
        If ws.Cells(i, C) = "" Then                      'Arrète de copier quand la ligne est vide (remplissage du tableau variable) permet de gagner en temps d'éxécution
            GoTo QuandLtabVIDE                           'Etiquette
        End If
    Next L
 
QuandLtabVIDE:
 
Next CoWo
 
        i = i + 1                       'prochaine ligne
        WDoc.Close False                'fermer le document Word sans enregistrer
        sNomFichier = Dir               'prochain document
Loop
 
SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit                           'Fermer l'instance de Word
    'Application.StatusBar = True        'Remise à zéro de la barre d'état (désactivé car screenupdating=false)
 
    tempsfin = Time()                   'Calcul et affiche le Tcy de la macro dans une msgbox en fin de macro
    tempschrono = tempsfin - tempsdebut
    MsgBox tempschrono
 
End Sub