XL 2019 Signet VBA Excel vers Word

laurent950 à dit:

Bonjour,

C'est intéressant de pouvoir remplir un document Word Modèle depuis Excel :
J'ai conservé aussi les signets après avoir remplis le document
C'est juste un essaie. A vous de l'adapter choix des bon éléments Excel à remplir vers Word
le principe est là avec le code ci-dessous. et quelques explications

1) Dans votre document Word il faut l'organiser avec des signets
2) lorsque les signets sont créés dans Word pour les repérer
* Options \ Options Avancées \ Affichér les signets [...]
3) Pour comprendre on imagine 3 Signets dans le documents Word
* Dim signet(1 To 3) As Word.Bookmark
4) Chaqu'un des 3 Signets doit être remplacé par une valeur depuis Excel vers Word
* LeMot(1 To 3) As String
5) Exemple si je veux changer le Signet(1) qui correspond à "Nom"
Par : LeNomDeLaPersonne
Alors :
Set signet(1) = WordDoc.Bookmarks("Nom") ' Depuis Word
LeMot(1) = Sheets("Consultation Pré-endodontique").Range("D5").Value ' Depuis Excel
Msgbox LeMot(1) ' LeNomDeLaPersonne
Puis pour Remplacer le Signet :
signet(i).Range.Text = LeMot(i)

6 ) Pour ne pas perdre l'origine des signets dans le documents Model (Lorsqu'il sera enregistrer sous)
* Je laisse le Mot qui prendra la place du signet
* Je rajoute le signets (comme à l'origine du fichier)
* en calculant la longueur de la chaine de caractère
* Range:=WordDoc.Range(Place, Place + Len(LeMot(i)))

7 ) Le fichier est enregistrer sous
* Au choix du nom du fichier

8 ) Aux choix pour organiser le travail pour remplir d'Excel vers Word :

9) Quelques condition pour Tester si :
* Si Le dossier Existe Ou Pas (Le créer)
* Word est Déjà Ouvert Ou Pas (L'ouvrir)
* Si le documents Modéle est ouvert Ou Pas (L'ouvrir)

Le code :

VB:

Sub CompleterWordDepuisExcel()
' Choix nom du dossier d'enregistrement '
    DossierNom = Application.InputBox("Word", "Word", "Nom du dossier WORD ?", Type:=2)
    DossierSauvegard = "C:\" & DossierNom & "\"
' Test si le DossierSauvegard est bien existant
'   * Dans le cas ou il n'existe pas le créer.
    Dim fs As Object
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FolderExists(DossierSauvegard) Then
            MsgBox "le repertoire existe donc rien a faire"
        Else
            MsgBox "le repertoire n'existe pas donc on le créer"
            fs.CreateFolder DossierSauvegard
        End If
    Set fs = Nothing
' Test Ouverture Application Word, si pas déjà Ouvert.
On Error Resume Next
    Dim WordApp As Word.Application
        Set WordApp = GetObject(, "Word.Application")
            If Err <> 0 Then
                Err.Clear
                Set WordApp = CreateObject("Word.Application")
            End If
        WordApp.Visible = True 'affiche le document Word
' Documents Word Modéle
    Dim WordDoc As Word.Document
        Set WordDoc = WordApp.Documents("[B]C:\DocumentWordFichier.docx")[/B]
On Error GoTo 0
' Si le Documents Word Modéle est fermé l'Ouvrir.
    If WordDoc Is Nothing Then
        MsgBox "Le document est fermé / Ouvrir le document"
        Set WordDoc = WordApp.Documents.Open("C:\DocumentWordFichier.docx")
    End If
' Remplir le Document Modéle.
' Comment insérer du texte dans un signet.
' Remplit le signet SignetOrigine avec le texte "LeMot" sans détruire SignetOrigine
' Exemple ci-dessous (Choisir les bonnes Référence excel pour LeMot
    Dim signet(1 To 3) As Word.Bookmark, LeMot(1 To 3) As String, i As Integer
    Dim Place As Long, SignetOrigine As String
        Set signet(1) = WordDoc.Bookmarks("Nom") '[Nom] : nom du signet
            LeMot(1) = Sheets("Feuil1").Range("A1").Value
        Set signet(2) = WordDoc.Bookmarks("Prénom") '[Prénom] : nom du signet
            LeMot(2) = Sheets("Feuil1").Range("T5").Value
        Set signet(3) = WordDoc.Bookmarks("Adresse") '[Adresse] : nom du signet
            LeMot(3) = Sheets("Feuil1").Range("B6").Value
' Remplir le document Word modele.
        For i = LBound(LeMot) To UBound(LeMot)
        ' Depart du signet
            Place = signet(i).Range.Start
        ' Nom du signet d'Origine
            SignetOrigine = signet(i).Name
        ' Substitue par le Mot (qui remplace le signet)
            signet(i).Range.Text = LeMot(i)
        ' Options \ Options Avancées \ Affichér les signets [...]
        ' Ne pas perdre le Signet d'origine [...] et sa mise en forme entre crochet
            WordDoc.Bookmarks.Add Name:=SignetOrigine, Range:=WordDoc.Range(Place, Place + Len(LeMot(i)))
        Next i
' Enregistrer le document sous (Exemple : LeMot(1) & "-" & LeMot(2))
            Dim fichier As String
            fichier = "DocumentWordFichier " & LeMot(1) & "-" & LeMot(2) & ".docx"
            WordDoc.SaveAs2 DossierSauvegard & fichier
End Sub

Cliquez pour agrandir...