Textbox vers signet word + enregistrement
Bonjour à tous,
Novice dans le domaine du VBA, j'ai besoin de votre aide pour un code me permettant d'envoyer des textboxs vers des signet word.
Voici ce que je voudrais exactement :
Dans un Userform j'ai plusieur textbox qui sont au préalable remplies, il me faudrait un code qui puissse ouvrir un document word "C:\Users\fguillemard\Documents\Fichier1.doc". Ensuite un code pour remplir les signets word. Puis pour eviter d'écraser le modèle word un code qui enregistre le fichier automatiquement sous "C:\Users\fguillemard\Documents\" sous le nom suivant "N° intervention_Combobox1_TextBox9_Textbox10" puis que le fichier enregistré reste ouvert.
Est-il possible de réaliser ceci ?
Merci d'avance
Cordialemet
Bonjour Flo,
Voici du code, à compléter, qui devrait répondre à ton besoin :
Private Sub CommandButton1_Click() ' Code du bouton Imprimer du Userform
Dim NDF As String, NDF2 As String, Rep As String
Dim WordApp As Object, WordDoc As Object
Rep = "C:\Users\fguillemard\Documents\"
NDF = Rep & "Fichier1.doc"
If Not Exist_Fichier(NDF) Then ' Verifie si le doc existe
MsgBox "Document word manquant", vbExclamation, "Floflo"
Else
On Error Resume Next
If Fichier_IsOpen(NDF) Then ' Verifie si le doc est déja ouvert
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
With WordApp
.Visible = False
' copie le contenu du textbox1 à l'emplacement du signet "ref"
.Selection.Goto what:=wdGoToBookmark, Name:="ref"
.Selection.TypeText Text:=Me.TextBox1.Text
' copie le contenu des textbox2 et 3 à l'emplacement du signet "NomPrenom"
.Selection.Goto what:=wdGoToBookmark, Name:="NomPrenom"
.Selection.TypeText Text:=Me.TextBox2.Text & " " & Me.TextBox3.Text
' etc ... à continuer ...
End With
' pour enregistrer le doc avec les divers éléments
NDF2 = Rep & Me.ComboBox1.Text & Me.TextBox9.Text & Me.TextBox10.Text & ".doc"
WordDoc.Application.ActiveDocument.SaveAs NDF2
WordApp.Visible = True ' laisse le doc ouvert
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Document word prêt"
End If
End Sub
' 2 fonctions pouvant être placées dans un module quelconque (ou dans le le code de l'USF)
Function Exist_Fichier(S As String) As Boolean ' vérifie si un fichier existe
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
Exist_Fichier = tatiak.FileExists(S)
End Function
Function Fichier_IsOpen(ByRef Ttk As String) As Boolean ' vérifie si un fichier est déjà ouvert
On Error Resume Next
Open Ttk For Input Lock Read As #1
Close #1
Fichier_IsOpen = (Err.Number <> 0)
End Function
Pierre
Bonjour Pierre,
Merci pour ta réponse, cela marche parfaitement.
J'ai juste changé une ligne de code par rapport au renvoi vers les signets qui ne marche pas sur mon fichier :
' copie le contenu du textbox2 à l'emplacement du signet "ref"
.Selection.Goto what:=wdGoToBookmark, Name:="signet2"
.Selection.TypeText Text:=Me.TextBox2.Text
Je l'ai remplacé par :
WordDoc.Bookmarks("signet1").Range.Text = Me.TextBox1.Text
La tout marche nickel !
Merci
Cordialement