VBA, excel: donner un titre à un fichier word

Version imprimable

06/05/2008, 16h43
pael013

VBA, excel: donner un titre à un fichier word

Bonjour,
j'ai un fichier excel avec dans ma 1er colonne des titres.
je voudrais creer pour chaque cellule de cette colonne un fichier word ayant pour nom de fichier "le titre de la cellule".
est possible d'avoir de l'aide pour creer une macro capable de founir ce travail ? merci d'avance
06/05/2008, 23h45
pael013

suite

en fait concretement, d'un coté j'ai un fichier excel avec des données classées par commune, de l'autre j'ai un fichier word modele.doc.
je veux creer pour chaque commune un fichier word avec comme nom de fichier le nom de la commune. ( ex: modele_marseille.doc)

dans un deuxieme temps je veux remplir les fichiers .doc avec les données correspondant à la commune.( pour cela je pense utiliser une macro qui utilise une boucle avec des signets caractéristiques dans word)

mais mon réel probleme est de creer un fichier word.

merci de votre aide

Salut,

le principe est d'ouvrir ton fichier modèle, de remplir les données correspondant à la commune, et puis de le sauver par Saveas sous le nom de commune que tu souhaites.

Voici le principe pour 1 record unique

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
 
    'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim FileName as string
 
 
    'ouvre session word
    Set WordApp = New Word.Application
    'ouvre du document Word
    Set WordDoc = WordApp.Documents.Open("Chemin_et_nom_du_modèle_y_compris_point.DOT")
    'word est masqué pendant l'opération
    WordApp.Visible = False
 
 
      ' insert Commune 
      'je suppose que ta commune est en A2"
 
        Range_id = "a2"
        Range(Range_id).Select
        Filename = ActiveCell.FormulaR1C1
        InsertTextAtBookMark "Commune",  Filename
 
    'Ferme le document word en sauvegardant les modifications
    WordDoc.SaveAs Filename:=Filename 'attention au pacth à ajouter
    WordDoc.Close
    'ferme la session Word
    WordApp.Quit
End Sub
Sub InsertTextAtBookMark(strBkmk As String, varText As Variant)
Dim m_objWord               As Word.Application
Dim m_objDoc                As Word.document
 
 
    m_objDoc.Bookmarks(strBkmk).Select
    m_objWord.Selection.Text = varText & ""
 
End Sub

Bonjour

Dans un premier temps voila un récapitulatif des solutions proposées remises en forme permettant de créer les documents.

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
  'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
  Dim WordApp As Word.Application
  Dim WordDoc As Word.Document
  Dim Cell As Range
  Dim Chemin As String
 
  Chemin = "C:\Tes docs\ton rep\"
 
  'ouvre session word
  Set WordApp = New Word.Application
 
  'Pour passer toutes les cellule renseignées de ta colonne A
  For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
 
    'ouvre du document Word
    Set WordDoc = WordApp.Documents.Open("Chemin_et_nom_du_modèle_y_compris_point.DOT")
    'word est masqué pendant l'opération
    WordApp.Visible = False
 
    'Ferme le document word en sauvegardant les modifications
    WordDoc.SaveAs FileName:=Chemin & Cell.Value & ".doc"
    WordDoc.Close
  Next
 
  'ferme la session Word
  WordApp.Quit

J'ai vérifié le code fonctionne en renseignant correctement les chemins

09/05/2008, 11h00
pael013

merci à tous mais...

Merci à tous de votre aide...

mais j'ai encore un petit souci:
pour la 1er instruction "Chemin = "C:\Tes docs\ton rep\"" que j'ai personnalisé, j'ai une erreur de compilation : "instruction incorrecte à l'exterieur d'une procedure"...

pouvez vous m'en dire un peu plus?
merci d'avance
09/05/2008, 11h37
zyhack
Bonjour

il faut que le code soit dans une procedure
Code:

1 2 3 4 5 Sub maProcedure() ' 'Ici tous le code ' End Sub
09/05/2008, 11h56
pael013

parfait

Parfait...c'est exactement ce que je voulais faire!!!!!!!
un grd merci...
probleme resolu