Discussion :

[freust]

Bonjour,

J'ai créé un formulaire sous Word (2003) et j'en importe les champs dans un classeur Excel (2003) via un script VBA créé à l'aide d'un script trouvé sur Internet.

Le principe est simple, j'ai un dossier qui contient tous les formulaires remplis, le fichier Excel qui, lorsqu'on l'ouvre, récupère les champs des formulaires présent dans ce même dossier.

Dans la logique survient un problème, imaginez que j'ai 2 formulaires remplis :

- J'ouvre le fichier Excel... (importation des données de ces deux formulaires)
- Mon fichier Excel est donc rempli de 2 lignes...

Maintenant imaginez que je modifie une donnée d'une de ces 2 lignes, ben lorsque je réouvre ce fichier Excel, il va remodifier cette donnée avec celle présente dans le formulaire Word.

Pareil, lorsque je vire un des deux formulaire du dossier, ben la ligne disparait du fichier Excel... embêtant quoi

Donc ce que j'aimerais c'est qu'une fois les données importées dans le fichier Excel, celui-ci ne touche plus à ces lignes même si je les modifie...

Je ne sait pas si ce que je dis est très clair, donc si vous avez des doutes, j'essaierais d'expliquer un peu plus explicitement

Voici le code déjà écrit :

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
 
Sub auto_open()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Synthèse")
chemin = "J:\AQ\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables  
' ****** À partir d'ici ****** 
Variables = Array("raisonsociale", "adresse", "telephone", "telecopie", _
    "internet", "TVA", "activites", "CA", "livraison", "reglement", _
    "direction", "commercial", "conception", "achats", "production", _
    "CQ", "AQ", "logistique", "RH", "finances", "siteseffectifs", _
    "fabricant", "distributeur", "prestataire", "typedeproduits", _
    "Oui1", "produitslabellises", "Non1", "Oui2", "personnelcertifies", _
    "Non2", "Oui3", "ISO", "Non3", "Date", "Nom", "Titre")
' 
' **************
 
nb_Champs = 37
num_row = 1
i = 0
 
For i = 0 To nb_Champs - 1
  Fich.Cells(num_row, i + 1) = Variables(i)
Next i
 
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
 
Do While mesfichiers <> ""
  If mesfichiers <> "." And mesfichiers <> ".." Then
    monDocument = chemin & mesfichiers
    FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
    num_row = num_row + 1
    num_col = 1
    For i = 0 To nb_Champs - 1
      Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
    Next i
    FichierWord.documents.Close (0)
  End If
  mesfichiers = Dir
Loop
FichierWord.Quit
 
End Sub

Merci d'avance pour l'aide que vous m'apporterez !

BJ

[Gorfael]

Salut freust et le forum
Sur un forum, la réponse dépend de l'attraction que peut induire le sujet. Mais il ne faut pas être trop pressé.

Pas envie de me creuser la tête sur word.
Pour ce que je comprends, il suffit de déplacer la ligne de copie.
Tu fixes :

Code :

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

num_row = 1

donc num_row deviens une constante de départ. il suffit qu'elle change si la ligne 1 n'est plus disponible pour appliquer la macro. On parle de la partie While, les titres, si tu veux les conserver dans ta macro, un test de leurs présences sautera cette partie.

Je pense que la colonne A sera toujours remplie, donc il suffit de tester la dernière ligne non vide en A :

Code :

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

num_row = [A65536].end(xlup).row

A+

[freust]

Merci Gorfael pour ta réponse ! Alors j'ai essayé avec votre bout de code, et donc, voilà le résultat :

Il ne touche bien évidemment plus aux lignes déjà présentes dans le dossier, mais il les remet à chaque fois que je recharge la macro... C'est à dire que si je la lance 5 fois ben j'aurais 5 fois la même ligne.

Je précise que je ne suis débutant en VBA et j'essaie dans la limite de mon possible de trouver seul... mais j'avoue que c'est difficile !

Merci encore de ton aide

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
 
Sub auto_open()
statusBarInitial = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Chargement des données des formulaires fournisseurs..."
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Synthèse")
chemin = "D:\Groupes\Gestion documentaire reseau\Fournisseurs\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables
Variables = Array("raisonsociale", "adresse", "telephone", "telecopie", _
    "internet", "TVA", "activites", "CA", "livraison", "reglement", _
    "direction", "commercial", "conception", "achats", "production", _
    "CQ", "AQ", "logistique", "RH", "finances", "siteseffectifs", _
    "fabricant", "distributeur", "prestataire", "typedeproduits", _
    "Oui1", "Non1", "produitslabellises", "Oui2", "Non2", "personnelcertifies", _
    "Oui3", "Non3", "ISO", "Date", "Nom", "Titre")
 
nb_Champs = 37
num_row = [A65536].End(xlUp).Row
i = 0
 
Dim AliasName
AliasName = Array("Raison sociale", "Adresse", "Téléphone", "Télécopie", _
    "Site internet", "N° de TVA", "Activités", "C.A.", "Conditions de livraison", _
    "Conditions de réglement", "Direction", "Commercial", "Conception", _
    "Achats", "Production", "C.Q.", "A.Q.", "Logistique", "R.H.", "Finances", _
    "Sites et effectifs", "Fabricant", "Distributeur", "Prestataire", _
    "Types de produits", "Oui", "Non", "Lequels ?", "Oui", "Non", _
    "Type de certificat ?", "Oui", "Non", "Organisme, date de validité ?", _
    "Date", "Nom", "Titre")
 
For i = 0 To nb_Champs - 1
  Fich.Cells(num_row, i + 1) = AliasName(i)
Next i
 
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
 
Do While mesfichiers <> ""
  If mesfichiers <> "." And mesfichiers <> ".." Then
    monDocument = chemin & mesfichiers
    FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
    num_row = num_row + 1
    num_col = 1
    For i = 0 To nb_Champs - 1
      Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
    Next i
    FichierWord.documents.Close (0)
  End If
  mesfichiers = Dir
Loop
FichierWord.Quit
Application.StatusBar = "Chargement des données des formulaires fournisseurs terminé !"
End Sub