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
|
Private Sub CommandButton1_Click()
Dim WordApp As Object, WordDoc As Object
Dim Fichier As String, FichierCopie As String, Titre As String
Dim i As Byte
Dim cfichier As New Scripting.FileSystemObject
'Application.DisplayAlerts = False
Fichier = "D:\macros\Production\Bancassurance\Courrier\TransmissTest.docx"
Titre = "BIA Accèpté de " & TextBox1 & " du " & Format(TextBox2, "dd-mm-yyyy")
'MsgBox Titre
If cfichier.FileExists("D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx") Then
MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
End
End If
cfichier.CopyFile Fichier, "D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx", True 'False
'False
FichierCopie = "D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx"
Set cfichier = Nothing
If Dir(Fichier) <> "" Then
Set WordApp = CreateObject("word.application") 'ouvre une session Word
Set WordDoc = WordApp.Documents.Open(FichierCopie)
For i = 1 To 20
If i = 5 Then
dform = Cells(2, i)
madate = Format(dform, "dd mmmm yyyy")
WordDoc.Bookmarks("Signet" & i).Range.Text = madate
ElseIf i = 9 Then
dform = Cells(2, i)
nombr = Format(dform, "#,0")
WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
Else
WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(2, i)
End If
Next i
WordDoc.Save
WordApp.Visible = True 'affiche le document Word
'WordDoc.PrintOut 'Pour imprimer le doc obtenu
'WordDoc.Close True 'ferme le document word en sauvegardant les données
'WordApp.Quit 'ferme la session Word
Else
MsgBox "Fichier introuvable"
End
End If
Unload Me
End Sub |
Partager