[VBA Excel] Automatiser copier-coller

Version imprimable

13/07/2015, 15h22
Beldramma

[VBA Excel] Automatiser copier-coller

Bonjour :)
Voila J'ai un tableau excel dont je dois remplir les deux dernieres colonnes avec des données contenues dans un fichier différent (dont j'ai accès et dont le nom se trouve dans chaque ligne) pour chaque ligne.
J'ai entendu dire qu'avec le langage (que je ne connais pas) Visual Basic, il était possible d'automatiser ce copier-coller, ce qui m'arrangerai bien sachant qu'il y en a plus de 1600...
Pourriez-vous m'aider ?
Merci :)
13/07/2015, 15h50
patricktoulon

heu

bonjour

a tu essayé de coder quelques lignes déjà ?
a tu au moins essayé de le faire manuellement en ayant activé l'enregistreur de macro?
13/07/2015, 16h50
Beldramma

bonjour patricktoulon

Alors pour l'instant j'en suis à la lecon 2 "les sélections" .
J'ai effectivement utilisé l'enregistreur de macro mais je ne suis pas plus loin, je n'ai pas assez de connaissances.
Je vais poster les opérations que je dois faire en détail...

Alors dans les colonnes G et H de mon tableau, se trouvent le nom d'un fichier word pour chaque ligne.

tous ces fichiers se trouvent dans un même dossier.

Dans chaque fichier word, se trouve un tableau. La ligne qui nous intéresse est malheureusement entre 8 et 10 selon les fichiers.

Dans cette ligne se trouve tout le temps le mot clé "consignes".

La ligne est sous la forme:

Consignes: Criticité

Description

Le premier élément "Criticité" va dans la colonne P de notre tableau et "Description" dans la colonne Q.

As-tu besoin de plus d'info ?

Pour trouver la bonne ligne, si ca peut aider, il faudrait un programme qui commence à la ligne 8 et qui "regarde" si le mot "Consignes" s'y trouve et sinon il passe à la ligne 9 et ce jusqu'à ce qu'il trouve la bonne ligne.
13/07/2015, 17h10
Igloobel

Bonjour,

Patrick Toulon (que je salue au passage :coucou: )t'as proposer de faire une macro sur un élément parmis tes 1600 à faire

en effet Excel propose un outil qui permet de transformer les manipulations manuelle en code VBA.
certes cet outil n'est pas parfait en autre il ne sait faire ni les conditions ni les boucles, mais il donne une bonne base pour travailler.

pour t'aider va

http://bidou.developpez.com/article/VBA/

une fois que tu auras donné un bout de code plein de gens vont venir t'aider à comprendre même si tu dis :

Heu ... la deuxième je comprends pas, ni la troisième et la quatrième est complètement obscure ... Etc ...

a bientôt

Je connais cette manip d'enregistrer une macro , grâce au lien précédemment donné :)
Merci pour le lien, je vais jeter un coup d'oeil :)

Bonjour :)
J'ai trouvé du code qui semble corespondre à ce que je cherche du moins pour importer un fichier word vers excel

Code:

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
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
' Par : Grand Chaman Excel -- 2013/03/05
'-----------------------------------------------------------------
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
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ChoisirRepertoire & "\"          '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 = True                        '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
 
        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
        Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression
 
        ' Nom du fichier
        ws.Cells(i, 1) = sNomFichier
 
        ' No de facture (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6              'Retourne au début du fichier Word
        WApp.Selection.Find.ClearFormatting         'on "vide la mémoire" de la fonction Recherche
        WApp.Selection.Find.Execute "N° Facture"    'On trouve le texte "No Facture"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i, 2) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par 2 ":"
 
        ' No Vendeur (dans le 2e tableau, ligne 2, colonne 1)
        WDoc.Tables(2).Cell(2, 1).Range.Copy        'copie la valeur dans le presse papier
        ws.Select                                   'bascule vers Excel
        ws.Cells(i, 3).PasteSpecial (xlPasteValues) 'colle la valeur dana la cellule
 
        ' No du bon de commande (dans le 2e tableau, ligne 2, colonne 2)
        WDoc.Tables(2).Cell(2, 2).Range.Copy
        ws.Select
        ws.Cells(i, 4).PasteSpecial (xlPasteValues)
 
        ' Nom du client (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "FACTURER À :"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, 5) = Split(WSel, ":")(1)
 
        ' Montant total dû (dans le 3e tableau, ligne 10, colonne 2)
        WDoc.Tables(3).Cell(10, 2).Range.Copy
        ws.Select
        ws.Cells(i, 6).PasteSpecial (xlPasteValues)
 
        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 = False       'Remise à zéro de la barre d'état
 
End Sub

Mais il vient d'un exemple précis je ne sais pas ce qui est à garder et ce que je dois rajouter...

14/07/2015, 10h58
tamtam64

enregistreur de macro

Salut,

Nous étudiants on est un peu flemmards.. lol , bon sans rire, je pense que tu devrais essayer l'enregistreur de macro pour faire exactement ce que tu veux , c'est ce qui t'as été conseillé et souvent ça aide.. ( même si avec le temps pour progresser ça n'est pas le mieux).
14/07/2015, 11h03
joe.levrai

Citation:

Envoyé par Beldramma

Je connais cette manip d'enregistrer une macro , grâce au lien précédemment donné :)
Merci pour le lien, je vais jeter un coup d'oeil :)

Bonjour,

nous sommes maintenant 4 à attendre le code que tu as réalisé avec l'enregistreur de macro

après réflexion, en fait ils ne sont plus que 3, inutile d'encombrer le fil de 4 propositions qui seront probablement identiques.

2 pièce(s) jointe(s)

Alors J'ai fait les opérations suivantes:

J'ai copié les colonnes G et H de la ligne 3 de mon tableau

Pièce jointe 183022

Puis j'ai ouvert mon gestionnaire de fichier dans mon fichier M****o, et dans la barre de recherche, j'ai collé
Ca m'a donné un fichier word que j'ai ouvert.
Dans ce fichier se trouve un tableau

Pièce jointe 183023

J'ai copié la ligne "consignes" que j'ai collé dans la colonne Q à la ligne 3 de mon tableau excel

Et voila le code enregistré:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub Macro2() ' ' Macro2 Macro ' ' Range("G3:H3").Select Selection.Copy Application.CutCopyMode = False ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 Range("Q3").Select ActiveCell.FormulaR1C1 = _ "xxxxxxxxxxxxxxxxxx" Range("Q5").Select End Sub
Mais L'enregistreur de macro n'enregistre t-il pas seulement ce qu'il se passe dans excel ?

14/07/2015, 14h27
Beldramma

Algorithme du programme

Je sais pas si ca peut aider, mais voila l'algorithme du programme:

Variables:

Lx est le numéro de ligne dans le tableau excel.

Lw est le numéro de ligne dans le tableau word.

Début algorithme:

Lx prend la valeur 3

Lw prend la valeur 8

Tant que Lx < 1627 \\ 1627 correspond au nombre de lignes dans le tableau à remplir

• Copier dans la ligne 3 les colonnes G et H

Chercher dans le répertoire M****o le nom collé

Si

Il y a plusieurs fichiers correspondants, passer à la ligne suivante

Sinon

ouvrir le dossier word correspondant

Dans le fichier correspondant, chercher le mot clé "Consignes" à partir de la ligne 8 jusqu'a trouver la ligne correspondante Lw

Fin Si

Si

Dans la ligne Lw sur la ligne ou se trouve "consignes" se trouve le mot clé "Critique", copier "Critique" dans la colonne P à la ligne Lx

Sinon

Copier "Absent" dans la colonne P à la ligne Lx

Fin Si

Si

dans la ligne du tableau il y a du texte, le copier dans la colonne Q à la ligne Lx

Sinon

Copier "Absent" dans la colonne Q à la ligne Lx

Fin Si

• Exécuter Lx prend la valeur Lx+1

Fin algorithme

Cette commande existe-elle ?

Code:

1
2
Range("Gligne_excel:Hligne_excel").Select \\ligne_excel est une variable
    Selection.Copy

15/07/2015, 01h02
tototiti2008
Bonsoir à tous,

Citation:

Cette commande existe-elle ?

Oui
Code:

1 2 3 Range("G" & ligne_excel & ":H" & ligne_excel).Copy\\ligne_excel est une variable
15/07/2015, 10h38
Beldramma

Correction de l'algorithme

Voila une correction de l'algorithme:
Variables:

Lx est le numéro de ligne dans le tableau excel.

i est le numéro de la ligne dans le tableau word

Début algorithme:

Lx prend la valeur 3

Tant que Lx < 1627 \\ 1627 correspond au nombre de lignes dans le tableau à remplir

• Copier dans la ligne Lx les colonnes G et H

Chercher dans le répertoire M****o le nom collé

Si

Il y a plusieurs fichiers correspondants, passer à la ligne suivante

Sinon

ouvrir le dossier word correspondant \\ dans le fichier word se trouve un tableau

Pour i allant de 8 à 10, faire \\ i corespond au numéro de ligne dans le tableau
Chercher à la ligne i le mot clé "Consignes"
Fin Pour si le mot clé est trouvé
i prend la valeur i+1

Fin Si

Si

Dans la ligne i sur la ligne ou se trouve "consignes" si on trouve le mot clé "Critique", copier "Critique" dans la colonne P à la ligne Lx

Sinon

Copier "Absent" dans la colonne P à la ligne Lx

Fin Si

Si

dans la ligne i il y a du texte, le copier dans la colonne Q à la ligne Lx

Sinon

Copier "Absent" dans la colonne Q à la ligne Lx

Fin Si

• Exécuter Lx prend la valeur Lx+1

Fin algorithme

Début programme

Voila le debut de mon programme

Code:

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
Sub programme_excel()

' -- Déclaration des variables
Dim Lx As Integer           'Ligne excel dans tableau excel
Dim i As Integer            'ligne word dans le tableau word
Dim sChemin As String       'répertoire contenant les fichiers Word
Dim sNomFichier As String   'nom du fichier Word formé par les colonnes G et H dans la ligne Lx
Dim WApp As Object, WDoc As Object, WSel As Object

' -- Initialisation des variables
Lx = 3 'Numéro de ligne de départ dans le tableau excel
 sChemin = "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco" 'fonction pour choisir le répertoire contenant les fichier Word
 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 = True                        'ne pas afficher Word pendant l'exécution
    
     Application.ScreenUpdating = False

 
' -- Programme

While ligne_excel < 1627 'Nombre total de ligne à remplir

   
    sNomFichier = Range("G" & Lx & ":H" & Lx) ' Nom du fichier
    

Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word


        


    

ligne_excel = ligne_excel + 1
Wend

End Sub

La ligne surligné en rouge bug et je ne comprend pas pourquoi, quel est le problème ?

15/07/2015, 14h20
Marc-L

Bonjour, bonjour !

Bug ne veut rien dire ‼ Sans informer le forum du message d'erreur, mettre un point d'arrêt sur la ligne en rouge,
lancer la procédure puis regarder enfin dans la fenêtre des Variables locales le contenu des variables de cette ligne ‼
Bref le B-A-BA du débogage …

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse
15/07/2015, 14h55
joe.levrai

Bonjour,

j'opte pour une erreur "incompatibilité de type" à vue de nez.

ta ligne 27 appelle à 2 remarques :

1) mineur : il est de bon ton d'indiquer la propriété utilisées (tu voulais prendre .Value non ?)

2) bloquante : même en corrigeant le point 1, tu cherches à affecter la valeur d'une plage de plusieurs cellules dans un string ... j'ai bien peur qu'une méthode globale ainsi ne fonctionne pas.

ne reste qu'à nous expliquer le but de cette démarche, en attendant voici les issues possibles :

- boucler cellule par cellule pour concaténer les valeurs ==> là tu pourras affecter à ton string l'ensemble des valeurs de ta plage (attention à la longueur !)

- effectuer une boucle dans ton code afin d'affecter à ton string la valeur de chaque cellule + y appliquer le traitement voulu

EDIT : et en point "0" ==> rattache tes ranges/cells à leur feuille parente ! C'est peut être pas bloquant dans ton cadre de test .... mais ça te jouera des tours tôt ou tard

En fait dans les colonnes G et H se trouve le nom partiel du fichier word auquel je veux accéder
C'est pour ca que j'aimerais attribuer à la variable sNomFichier ce qui est selectionné

Nouveau code

Code:

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
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
' Par : Grand Chaman Excel -- 2013/03/05
'-----------------------------------------------------------------
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

    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ChoisirRepertoire & "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco"    'fonction pour choisir le répertoire contenant les fichier Word
    
    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 = True                        'ne pas afficher Word pendant l'exécution
    i = 3   '1re ligne où on va écrire les données dans le fichier Excel

    Application.ScreenUpdating = False

    ' -- Boucle sur les fichiers
        While i < 1627 'Nombre total de ligne à remplir
        ' Nom du fichier
        ws.Cells(i, 9).Value = sNomFichier
        
        Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word        
      Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression

Wend 
End Sub

Voila ou j'en suis actuellement.
J'ai fusionné dans mon tableau les deux cellules G et H pour donner la cellule I .
La ligne surligné pose problème. En effet lors de son éxécution,un panneau s'affiche "Le serveur distant n'existe pas ou n'est pas disponible"
Dans les variables locales, bizzarement, pour sNomFichier sa valeur est ""

De plus pour la ligne

Code:

ws.Cells(i, 9).Value = sNomFichier

j'aimerais que sNomFichier prenne cette valeur sans que je perde cette donnée dans mon tableau

15/07/2015, 17h02
tototiti2008

Bonjour à tous,

Peut être dans la ligne là :

Code:

sChemin = ChoisirRepertoire & "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco"

Ajoute un \ à la fin du chemin

Code:

sChemin = ChoisirRepertoire & "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco\"

Que vaut ChoisirRepertoire ?
15/07/2015, 18h12
Beldramma

Merci tototiti2008, ca commence à marcher :)
J'ai réussi à ouvrir un fichier word, mais pas le bon.

En effet, quand je compile mon programme, la ligne

Code:

sNomFichier = Dir(sChemin & "*.doc*")

attribue un nom de fichier qui ne change pas à sNomFichier alors que je voudrais qu'il lui soit donné le nom en Cellule(i,9).

Code:

ws.Cells(i, 9).Value = sNomFichier

De plus le nom dans la cellule(i, 9) n'est pas complet mais suffit normalement à distinguer un fichier parmi tous les autres. Cela pose-t-il problème ?
15/07/2015, 18h25
SfJ5Rpw8

Bonsoir,

Beldramma , il semble que tu ait des problème avec l'opérateur = .. fait une recherche dans l'aide en ligne Excel "Opérateur =" :f1:..

ensuite oui pour ouvrir un fichier il te faut son nom complet ... mais l'instruction Dir devrais peu-être t'aider pour compléter ce nom ....
16/07/2015, 10h36
Beldramma

j'aimerais attribuer à ma variable sNomFichier le nom de mon doc dans la colonne 9 en fonction de la ligne i.
J'ai essayé suivant tes conseils bbil la commande Dir("Chemin d'accès", MacID("TEXT")) en remplacant "Chemin d'accès" et "Text" par

Code:

sNomFichier = Dir(sChemin & MacID(ws.Cells(i, 9).Value))

Mais elle n'attribue rien à ma variable
Que faire ?
16/07/2015, 11h21
SfJ5Rpw8

Bonjour,

MACID ? tu est vraiment sous Macintosh ?
16/07/2015, 12h23
Beldramma

Non... mais ce qui m'etait donné quand j'ai fait F1
Donc je dois mettre quoi à la place ?

Finalement j'ai trouvé, je l'ai remplacé par

Code:

sNomFichier = Dir(sChemin & (ws.Cells(i, 9).Value))

mais j'ai mis dans la cellule le nom complet
Or normalement, le nom n'est pas complet. Et si j'execute cette ligne en remettant ce qu'il y a dans la cellule normalement, le programme ne trouve pas le document.
Existe-t-il une manière pour dire à ma commande de chercher les documents qui contiennent les caractères de la cellule et non de dire à la commande que le nom du doc est ce qu'il y a dans la cellule ?

Aussi, il se peut que pour ce que contient la cellule, cela renvoie à plusieurs fichiers au lieu d'un. Ainsi j'aimerais que si le nombre de fichiers correspondants est supérieur à 1, on passe directement à la ligne suivante. Comment puis je le mettre dans mon programme ?

Code:

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
174
175
176
'Option Explicit
 
' ----------------------------------------------------------------
' Extraction dedonnées à partir de fichier Word vers Excel
'-----------------------------------------------------------------
Public Enum colExcelConsigne
    statut = 2
    'debutNomWord = 9
    PremierdebutNomWord = 7
    SeconddebutNomWord = 8
    sConsignes = 18
    sCriticité = 17
End Enum
 
 
' pour utiliser ce programme il faut instrumenter la preference : Microsoft Word 9.0 Object library
 
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
    Dim i As Integer            'numéro de ligne dans le tableau excel
    Dim Lw As Integer           'numéro de ligne dans le tableau word
 
    Dim tabListeFile() As Variant
    Dim saut_de_ligne As Integer
    Dim numéro_caractere As Integer
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = "C:\"    'fonction pour choisir le répertoire contenant les fichier Word
 
 
 
 
 
 
 
    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = False                       'Indiquez False pour garder l'application masquée
 
 
    Application.ScreenUpdating = False
 
    sNomFichier = ""
    'STEP 1
    'On rempli un tableau qui comprend le path complet des fichiers de consigne
    'TODO mettre en place un filtre sur .doc/.docx
    sNomFichier = Dir(sChemin)
    While (sNomFichier <> "")
 
        'Debug.Print li & "-" & sNomFichier
        ReDim Preserve tabListeFile(li)
        tabListeFile(li) = sNomFichier
        li = li + 1
        sNomFichier = Dir()
    Wend
 
    lLigneDebutExcel = 3 '3
    lNbreFichierWord = 2116 '2116
 
   'STEP 2 on recherche le fichier à ouvrir
   '
   ' -- Boucle qui incrémente les lignes Excel
    For lLigneExcel = lLigneDebutExcel To lLigneDebutExcel + lNbreFichierWord '2119 Nombre total de ligne à remplir
        cpt = 0
        '-- Boucle qui incrémente le tableau tabListeFile
        For lLigneTableau = 0 To UBound(tabListeFile)
            'Check si la ligne Excel est à traiter
            'debutNomWord Différent de "" et statut=NEW
 
            sPremierePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.PremierdebutNomWord).Value)
            sDeuxiemePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.SeconddebutNomWord).Value)
            sNomCompletDuFichier = UCase(tabListeFile(lLigneTableau))
 
            'Debug.Print "sDebutNomWordFromExcel:" & "-" & lLigneExcel & "-" & sDebutNomWordFromExcel
            'Debug.Print "sNomCompletDuFichier:" & "-" & lLigneTableau & "-" & sNomCompletDuFichier
 
 
             If (Trim(sPremierePartieDebutNomWordFromExcel) <> "") And (Trim(sDeuxiemePartieDebutNomWordFromExcel) <> "") And (UCase(ws.Cells(lLigneExcel, colExcelConsigne.statut).Value) = "NEW") Then
 
 
                If InStr(sNomCompletDuFichier, sPremierePartieDebutNomWordFromExcel) <> 0 And InStr(sNomCompletDuFichier, sDeuxiemePartieDebutNomWordFromExcel) <> 0 Then
 
                'If (sDebutNomWordFromExcel = UCase("pemo_aoly2019_stopusreom")) Then
                '   Debug.Print "-------------------------pemo_aoly2019_stopusreom-----------------------------------------------------"
                'End If
 
 
                    cpt = cpt + 1
 
                    'STEP 3 on récupére les infos du fichier word pour les coller dans le fichier Excel
                    Debug.Print "------------------------------------------------------------------------------"
                    Debug.Print "sNomCompletDuFichier:" & "-" & lLigneTableau & "-" & sNomCompletDuFichier
                    Debug.Print "------------------------------------------------------------------------------"
                    '
                    sPathCompletWord = sChemin & sNomCompletDuFichier
                    Set WDoc = WApp.Documents.Open(sPathCompletWord)    'ouvre le document Word
 
 
                     For i = 1 To WDoc.Tables(1).Rows.Count
 
                            sInfo = WDoc.Tables(1).Rows(i).Cells(1) 'On attribue à sInfo le contenu de la cellule 1 à la ligne i
 
 
                            If InStr(1, sInfo, "Instructions") <> 0 Or InStr(1, sInfo, "Consignes") <> 0 Then  'Si on trouve le mot "Consignes" à la ligne i alors
 
                               If InStr(1, LCase(sInfo), "critique") <> 0 Or InStr(1, LCase(sInfo), "critical") <> 0 Or InStr(1, LCase(sInfo), "crititique") <> 0 Then     'Si on trouve le mot critique à la ligne i alors
 
                            saut_de_ligne = InStr(1, sInfo, Chr(13)) 'On cherche le numéro du premier retour chariot
                            nombre_caractere = saut_de_ligne - 1
 
                            Criticité = Left(sInfo, nombre_caractere) 'On copie tout ce qu'il y a avant le retour chariot dans la variable Criticité
 
                            ws.Cells(lLigneExcel, sCriticité) = Criticité 'on colle son contenu dans la ligne excel correpondante dans la colonne Criticité
 
                            Debut_Description = saut_de_ligne + 1
                            sDescription = Mid(sInfo, Debut_Description)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription ' on colle la valeur dana la cellule
                            Else
                            ws.Cells(lLigneExcel, sCriticité) = "Absent"
                            sDescription = Mid(sInfo, 11)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription 'colle la valeur dana la cellule
                                End If
 
 
 
 
 
 
 
 
 
                             End If
 
 
 
 
 
 
 
                    Next i
                'WDoc.Bookmarks
 
 
 
                   WDoc.Close    'fermeture document Word
 
 
 
                End If
 
 
            End If
 
 
 
        Next
        'If (cpt > 1) Then
        '    Debug.Print sMyFile & ":" & cpt
        'End If
 
 
 
 
    Next
 
    WApp.Quit    'fermeture session Word
 
 
End Sub

J'ai pas mal avancé de mon côté voila mon code.

Il me reste une dernière partie que j'aimerais faire, en effet mon programme cherche dans les fichiers word des tableaux mais ces fichiers sont vieux et dans mon entreprise, ils sont en train de passer ces fichiers .doc en .docx.

Dans ces fichiers ils ont remplacé le tableau par des signets. Ce que j'aimerais faire maintenant serait une boucle for qui parcourerait tous les signets de ce fichier word et chercherai dedans les mots clé "Consignes" ou "Instructions.

J'avais commencé comme ceci

Code:

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
For j = 1 To WordDoc.Bookmarks(numero_signet) 'on parcoure tous les signets du fichiers word ouvert
 
        numero = signet + 1
         WordDoc.Bookmarks(numero_signet).Range.Text = Cells(i, 1) 'On attribue le contenu du signet à une variable sInfo
 
    If InStr(1, sInfo, "Instructions") <> 0 Or InStr(1, sInfo, "Consignes") <> 0 Then  'Si on trouve le mot "Consignes" dans la variable alors
 
                               If InStr(1, LCase(sInfo), "critique") <> 0 Or InStr(1, LCase(sInfo), "critical") <> 0 Or InStr(1, LCase(sInfo), "crititique") <> 0 Then     'Si on trouve le mot critique dans la variable alors
 
                            saut_de_ligne = InStr(1, sInfo, Chr(13)) 'On cherche le numéro du premier retour chariot
                            nombre_caractere = saut_de_ligne - 1
 
                            Criticité = Left(sInfo, nombre_caractere) 'On copie tout ce qu'il y a avant le retour chariot dans la variable Criticité
 
                            ws.Cells(lLigneExcel, sCriticité) = Criticité 'on colle son contenu dans la ligne excel correpondante dans la colonne Criticité
 
                            Debut_Description = saut_de_ligne + 1
                            sDescription = Mid(sInfo, Debut_Description)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription ' on colle la valeur dana la cellule
                            Else
                            ws.Cells(lLigneExcel, sCriticité) = "Absent"
                            sDescription = Mid(sInfo, 11)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription 'colle la valeur dana la cellule
                                End If
         Next j

Mais je ne pense pas que ce programme marche.

Merci de votre aide...

23/07/2015, 11h53
joe.levrai

Bonjour,

1) que représente ta variable "numero" en ligne 3
2) que représente ta variable "signet" en ligne 3
==> t'as une variable "numero_signet" mais pas les deux dont je viens de parler
3) à quoi sert cet incrément effectué en ligne 3
4) ta boucle For/Next en ligne 1 a été modifiée pour utiliser la variable j ... or tu as encore des références à l'ancienne variable i en ligne 4

Voilà, regarde ces diverses problématiques pour commencer

Voila mon code peaufiné:

Code:

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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
'Option Explicit
 
' ----------------------------------------------------------------
' Extraction dedonnées à partir de fichier Word vers Excel
'-----------------------------------------------------------------
Public Enum colExcelConsigne
    statut = 2 'colonne du même nom
    PremierdebutNomWord = 7 'colonne G
    SeconddebutNomWord = 8 'colonne H
    ColonneNomComplet = 9 'colonne I
    sCriticité = 17 'Colonne Q
    sConsignes = 18 'Colonne R
 
End Enum
 
 
' pour utiliser ce programme il faut instrumenter la preference : Microsoft Word 9.0 Object library
 
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          'Fenêtre word
    Dim WDoc As Object
    Dim i As Integer            'numéro de ligne dans le tableau word
 
 
    Dim tabListeFile() As Variant        'tableau virtuel créé à partir du répertoire sChemin
    Dim saut_de_ligne As Integer          'numéro du premier retour chariot
    Dim li As Integer                    'compteur
    Dim lLigneDebutExcel As Integer      'ligne Excel de départ
    Dim lNbreFichierWord As Integer       'Variable additionné à lLigneDebutExcel pour donner lLigneExcel
    Dim lLigneExcel As Integer           'Numéro de ligne Excel
    Dim cpt As Integer                   'compteur
    Dim lLigneTableau                              'numéro de ligne dans le tableau virtuel tabListeFile()
    Dim sPremierePartieDebutNomWordFromExcel As Variant 'texte dans la colonne G à la ligne lLigneExcel
    Dim sDeuxiemePartieDebutNomWordFromExcel As Variant 'texte dans la colonne H à la ligne lLigneExcel
    Dim sNomCompletDuFichier As Variant            'Comme son nom l'indique
    Dim sPathCompletWord As Variant                'Chemin et nom complet du fichier
    Dim sInfo As Variant                           'Contient les infos du tableau word à la ligne i
    Dim nombre_caractere As Integer                'nombre de caractères à copier à partir de la gauche dans le fichier word à la ligne i
    Dim Criticité As Variant                       'Texte qu'on colle à la ligne lLigneExcel dans la colonne Criticité
    Dim Debut_Description As Integer               'numéro de caractère à partir duquel on copie le texte dans le fichier word à la ligne i
    Dim sDescription As Variant                    'Texte qu'on colle à la ligne lLigneExcel dans la colonne Consignes
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook                       'on sauvegarde dans la page excel ouverte
    Set ws = wb.Sheets(1)                       'on sauvegarde dans le premier onglet
    sChemin = "J:\200 - Applications_ISY\20.33 - Advantage\Antoine\NSM - Monaco\Monaco\"    'fonction pour choisir le répertoire contenant les fichier Word
 
 
    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = True                       'Indiquez False pour garder l'application masquée
 
 
    Application.ScreenUpdating = False
 
    sNomFichier = ""
    'STEP 1
    'On rempli un tableau qui comprend le path complet des fichiers de consigne
    'TODO mettre en place un filtre sur .doc/.docx
    sNomFichier = Dir(sChemin)
    While (sNomFichier <> "")
 
        'Debug.Print li & "-" & sNomFichier
        ReDim Preserve tabListeFile(li)
        tabListeFile(li) = sNomFichier
        li = li + 1
        sNomFichier = Dir()
    Wend
 
    lLigneDebutExcel = 3 '3
    lNbreFichierWord = 2116 '2116
 
   'STEP 2 on recherche le fichier à ouvrir
   '
   ' -- Boucle qui incrémente les lignes Excel
    For lLigneExcel = lLigneDebutExcel To lLigneDebutExcel + lNbreFichierWord '2119 Nombre total de ligne à remplir
        cpt = 0
 
        For lLigneTableau = 0 To UBound(tabListeFile)
 
            sPremierePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.PremierdebutNomWord).Value)
            sDeuxiemePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.SeconddebutNomWord).Value)
            sNomCompletDuFichier = UCase(tabListeFile(lLigneTableau))
 
 
 
            If (Trim(sPremierePartieDebutNomWordFromExcel) <> "") And (Trim(sDeuxiemePartieDebutNomWordFromExcel) <> "") And (UCase(ws.Cells(lLigneExcel, colExcelConsigne.statut).Value) = "NEW") Then
                 If InStr(sNomCompletDuFichier, sPremierePartieDebutNomWordFromExcel) <> 0 And InStr(sNomCompletDuFichier, sDeuxiemePartieDebutNomWordFromExcel) <> 0 Then
                    cpt = cpt + 1
 
                End If
            End If
        Next
 
 
        If (cpt = 1) Then
        '-- Boucle qui incrémente le tableau tabListeFile
        For lLigneTableau = 0 To UBound(tabListeFile)
        cpt = 0
            'Check si la ligne Excel est à traiter
            'debutNomWord Différent de "" et statut=NEW
 
            sPremierePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.PremierdebutNomWord).Value)
            sDeuxiemePartieDebutNomWordFromExcel = UCase(ws.Cells(lLigneExcel, colExcelConsigne.SeconddebutNomWord).Value)
            sNomCompletDuFichier = UCase(tabListeFile(lLigneTableau))
 
            'Debug.Print "sDebutNomWordFromExcel:" & "-" & lLigneExcel & "-" & sDebutNomWordFromExcel
            'Debug.Print "sNomCompletDuFichier:" & "-" & lLigneTableau & "-" & sNomCompletDuFichier
 
 
             If (Trim(sPremierePartieDebutNomWordFromExcel) <> "") And (Trim(sDeuxiemePartieDebutNomWordFromExcel) <> "") And (UCase(ws.Cells(lLigneExcel, colExcelConsigne.statut).Value) = "NEW") Then
 
 
                If InStr(sNomCompletDuFichier, sPremierePartieDebutNomWordFromExcel) <> 0 And InStr(sNomCompletDuFichier, sDeuxiemePartieDebutNomWordFromExcel) <> 0 Then
 
                'If (sDebutNomWordFromExcel = UCase("pemo_aoly2019_stopusreom")) Then
                '   Debug.Print "-------------------------pemo_aoly2019_stopusreom-----------------------------------------------------"
                'End If
 
 
                    cpt = cpt + 1
 
                    'STEP 3 on récupére les infos du fichier word pour les coller dans le fichier Excel
                    Debug.Print "------------------------------------------------------------------------------"
                    Debug.Print "sNomCompletDuFichier:" & "-" & lLigneTableau & "-" & sNomCompletDuFichier
                    Debug.Print "------------------------------------------------------------------------------"
                    '
                    sPathCompletWord = sChemin & sNomCompletDuFichier
                    ws.Cells(lLigneExcel, ColonneNomComplet) = sNomCompletDuFichier
                    Set WDoc = WApp.Documents.Open(sPathCompletWord, ReadOnly = False)  'ouvre le document Word
 
 
                     For i = 1 To WDoc.Tables(1).Rows.Count
                       For j = 1 To WDoc.Tables(1).Columns.Count
                                'sInfo = WDoc.Tables(1).Columns(j).Cells(i)
 
                                On Error Resume Next
                                sInfo = WDoc.Tables(1).Cell(i, j).Range
                                If Err.Number <> 0 Then
                                    Exit For
                                    Err.Clear
                                End If
                            'sInfo = WDoc.Tables(1).Rows(i).Cells(1) 'On attribue à sInfo le contenu de la cellule 1 à la ligne i
 
 
                            If InStr(1, sInfo, "Instructions") <> 0 Or InStr(1, sInfo, "Consignes") <> 0 Or InStr(1, sInfo, "Consigne") <> 0 Or InStr(1, sInfo, "Consigns") <> 0 Or InStr(1, LCase(sInfo), "critique") <> 0 Then  'Si on trouve le mot "Consignes" à la ligne i alors
 
                               If InStr(1, LCase(sInfo), "critique") <> 0 Or InStr(1, LCase(sInfo), "critical") <> 0 Or InStr(1, LCase(sInfo), "crititique") <> 0 Or InStr(1, LCase(sInfo), "bloquant") <> 0 Then     'Si on trouve le mot critique à la ligne i alors
 
                            saut_de_ligne = InStr(1, sInfo, Chr(13)) 'On cherche le numéro du premier retour chariot
                            nombre_caractere = saut_de_ligne - 1
 
                            Criticité = Left(sInfo, nombre_caractere) 'On copie tout ce qu'il y a avant le retour chariot dans la variable Criticité
 
                            ws.Cells(lLigneExcel, sCriticité) = Criticité 'on colle son contenu dans la ligne excel correpondante dans la colonne Criticité
 
                            Debut_Description = saut_de_ligne + 1
                            sDescription = Mid(sInfo, Debut_Description)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription ' on colle la valeur dana la cellule Consignes
 
                            Else
                            ws.Cells(lLigneExcel, sCriticité) = "Absent"
                            sDescription = Mid(sInfo, 11)
                            ws.Cells(lLigneExcel, sConsignes) = sDescription 'colle la valeur dana la cellule Consignes
 
                                End If
 
 
 
 
 
 
 
 
 
                             End If
 
 
 
 
 
 
 
                    Next j
 
 
                   Next i
 
                   WDoc.Close    'fermeture document Word
 
 
 
                End If
 
 
            End If
 
 
 
        Next
 
       End If
 
        If (cpt > 1) Then
        Debug.Print sPathCompletWord & ":" & cpt
       ws.Cells(lLigneExcel, ColonneNomComplet) = "Plusieurs fichiers correpondants"
    End If
 
 
 
    Next
 
    WApp.Quit    'fermeture session Word
 
 
End Sub

Alors ta question 1 et 2, je voulais mettre numero_signet aux deux.
Pour la question 3, Cela devait servir pour parcourir tous les signets.
Merci pour 4eme remarque je n'avais pas vu :)

24/07/2015, 15h44
joe.levrai

Ces petits ajustements fait, tu ne nous dis pas s'il reste des anomalies ou des problématiques dans ton code