Bouton pour renvoyer la saisie d'un userform dans un document Word

Bonjour,

Depuis pas très longtemps je me suis lancée à optimiser mes outils de travail pour gagner du temps par la mise en place de formulaire me permettant ainsi de ne faire qu'une saisie d'informations et ayant différents utilités, tableaux de synthèses, incrémentation de références etc...

J'ai placé dan mon formulaire (userform) un bouton pour que lorsque je créé un nouvel ordre dont je renseigne toutes les comboboxs et textboxs, je puisse en un clic faire une sorte de publipostage vers un document word.

J'ai tout tenté et rien ne fonctionnait, si bien que je me suis rabattue sur un système plus simple, dans l'userfom que je renseigne j'ai mis dans une combobox que j'ai renommé (textbox5), une liste avec les 3 chemins de mes documents. Si bien que mon idée en fonction de l'odre émis je sélectionne mon document word (où donc ce chemin complet du répertoire où il est placé), pour ensuite par un bouton quand je clique dessus cela m'ouvre ce document word et ensuite je travaille directement dans ce document word où j'ai déjà placé mes champs pur faire un publipostage manuel.

Mon problème, c'est que le code que j'ai utilisé à mon bouton, ne fonctionne pas. J'ai bien coché dans la liste références "Microsoft word Librairy ", mais rien n'y fait. après quelques temps de recherches et rien, j'use de ce post pour vous demander de l'aide si toutefois quelqu'un aurait une solution???

Private Sub CommandBouton6_Click()
Dim Wd As Object
 Dim Dc As Object
 Dim Fichier As String

On Error Resume Next

 Fichier = ThisWorkbook.Path & "" & Trim(Me.TextBox5) & ".doc"
 If Dir(Fichier) <> "" Then
 Set Wd = GetObject(, "Word.Application")
 If Err <> 0 Then
Err.Clear
 Set Wd = CreateObject("Word.Application")
 End If
 Wd.Visible = True
 Set Dc = Wd.Documents.Open(Fichier)
 Else
 MsgBox "Fichier """ & Fichier & """ introuvable."
 End If

End Sub

D'avance merci

Bonjour,

Voici du code que j'utilise régulièrement (sans aucune réf à cocher)

Private Sub CommandBouton6_Click()
Dim WordApp As Object, WordDoc As Object
Dim Ndf as string

    Ndf = ThisWorkbook.Path & "\Fiche.docx"

    If Not Exist_Fichier(Ndf) Thenhttps://forum.excel-pratique.com/ucp.php?mode=login
       MsgBox "Document 'Fiche.docx' absent du répertoire courant", vbExclamation, ""
    Else
        On Error Resume Next
        If Fichier_IsOpen(Ndf) Then
            Set WordApp = GetObject(, "Word.Application")
            Set WordDoc = WordApp.Documents(Ndf)
        Else
            Set WordApp = CreateObject("Word.Application")
            Set WordDoc = WordApp.Documents.Open(Ndf, ReadOnly:=False)
        End If

        ' Complète le doc word
        ' ...

    Ndf = ThisWorkbook.Path & "\Fiche_" & CLng(Date) & ".docx"
        WordDoc.Application.ActiveDocument.SaveAs Ndf

        WordApp.Visible = True
        Set WordDoc = Nothing
        Set WordApp = Nothing
        MsgBox "Document word prêt"
    End If
End Sub

Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object

    Set tatiak = CreateObject("Scripting.FileSystemObject")
    Exist_Fichier = tatiak.FileExists(S)
    Set tatiak = Nothing
End Function

Function Fichier_IsOpen(ByRef tatiak As String) As Boolean
    On Error Resume Next
    Open tatiak For Input Lock Read As #1
    Close #1
    Fichier_IsOpen = (Err.Number <> 0)
End Function

Pierre

Bonjour,

Merci pour votre code et votre proposition, rien ne se passe quand je clique sur mon bouton malgré avoir corrigé le code tel que vous me l'avez suggéré.

Si il y a une autre solution je suis preneuse!!!

Re

Le code proposé fonctionne parfaitement sous PC 64bits W10 + Office 2016 32bits.

Mais reste à compléter les lignes de code pour enrichir le docx, à la place des lignes=>

        ' Complète le doc word
        ' ...

Ca peut être, par exemple, un truc genre :

        With WordDoc
            .bookmarks("signet1").Range.Text = "blabla1"
            .bookmarks("signet2").Range.Text = "blabla2"
        End With

Pierre