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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
|
Option Explicit
Sub Mod01_ExportVersWord()
Dim AireWord As Range, AireExports As Range
Dim I As Integer
Dim RepertoireWord As String, FichierWord As String, RepertoireOffres As String, FichierClient As String
Dim oWdApp As Word.Application
Dim oWdDoc As Word.Document
With Sheets("Liste des exports")
RepertoireWord = .Range("RepertoireDocument")
FichierWord = RepertoireWord & .Range("DocumentEnCours")
RepertoireOffres = .Range("RepertoireDesOffres")
FichierClient = RepertoireOffres & .Range("NomOffreClient")
Set AireExports = .ListObjects("TableDesExports").ListColumns("Nom").DataBodyRange
AireExports.Offset(0, 2).ClearContents
ChDir RepertoireWord
End With
' Ouverture du fichier modèle Word
'---------------------------------
Set oWdApp = CreateObject("Word.Application")
With oWdApp
.Visible = True
Set oWdDoc = oWdApp.Documents.Add(Template:=FichierWord)
End With
For I = 1 To AireExports.Count
With AireExports(I)
If .Offset(0, 3) = "X" Then
Select Case .Value
Case "Matériel"
Set AireWord = Sheets("Matériel").Range("Matériel[[#Data],[#Totals],[Désignation]:[Total CHF]]")
Case "Mobilier"
Set AireWord = Sheets("Mobilier").Range("Mobilier[[#Data],[#Totals],[Désignation]:[Total CHF]]")
Case "Logistique"
Set AireWord = Sheets("Logistique").Range("Logistique[[#Data],[#Totals],[Désignation]:[Total CHF]]")
Case "Recap"
Set AireWord = Sheets("Recap").Range("Recap")
Case "Personnel"
Set AireWord = Sheets("Personnel").Range("Personnel[[#Data],[#Totals],[Colonne1]:[Total CHF]]")
Case "Boissons"
Set AireWord = Sheets("Boissons").Range("Boissons[[#Data],[#Totals],[Désignation]:[Total CHF]]")
End Select
EnvoyerDonneesVersWord oWdApp, oWdDoc, .Offset(0, 1), AireWord
.Offset(0, 2) = Now
End If
End With
Next I
With oWdDoc
.SaveAs2 Filename:=FichierClient, FileFormat:=12
.Close savechanges:=True
End With
oWdApp.Quit
MsgBox "Fin de l'export !", vbInformation
Set oWdApp = Nothing
Set oWdDoc = Nothing
Set AireWord = Nothing
Set AireExports = Nothing
End Sub
Sub EnvoyerDonneesVersWord(ByVal oWdApp2 As Word.Application, ByVal oWdDoc2 As Word.Document, ByVal SignetCible As String, ByVal AireSource As Range)
Dim Repertoire As String
Dim I As Integer
AireSource.Copy
With oWdDoc2
If .Bookmarks.Exists(SignetCible) = False Then
MsgBox "Absence du signet " & SignetCible & " !", vbCritical
End If
.Bookmarks(SignetCible).Select
With oWdApp2
.Selection.PasteExcelTable True, False, False
End With
End With
Application.CutCopyMode = False
End Sub |
Partager