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
|
Sub EnvoyerDonneesExcelVersWord(ByVal NomDuDocument As String)
Dim oWdApp As Word.Application, oWdDoc As Word.Document ' En early binding (Si Word est référencé)
' Dim oWdApp As Object, oWdDoc As Object ' En late binding
Dim Repertoire As String
Dim AireMateriel As Range
Dim I As Integer
On Error GoTo FinWord
Set AireMateriel = Sheets("Matériel").Range("Matériel[[#Data],[#Totals],[Désignation]:[Total CHF]]")
AireMateriel.Copy ' Copie les données Excel
Set oWdApp = CreateObject("Word.Application")
Set oWdDoc = oWdApp.Documents.Add
oWdApp.Visible = True
'Ouvre le document Word
' Repertoire = "\\Home3.corp.ads.migros.ch\usrhome$\M0064768\Desktop\Fichiers Test\"
Repertoire = ActiveWorkbook.Path & "\"
Set oWdDoc = oWdApp.Documents.Open(NomDuDocument) 'Repertoire & "Offre_test.docm")
With oWdDoc
If .Bookmarks.Count = 0 Then
MsgBox "Absence de signet Matériel !", vbCritical
GoTo FinWord
End If
If .Bookmarks.Exists("Matériel") = False Then
MsgBox "Absence de signet Matériel !", vbCritical
GoTo FinWord
End If
.Bookmarks("Matériel").Select
oWdApp.Selection.PasteSpecial Link:=True, DataType:=0, Placement:=0, DisplayAsIcon:=False
.Close savechanges:=True
End With
Application.CutCopyMode = False 'Annuler le mode couper/copier
MsgBox "Fin de mise à jour !", vbInformation
GoTo FinWord
FinWord:
oWdApp.Quit
Set AireMateriel = Nothing
Set oWdApp = Nothing
Set oWdDoc = Nothing
End Sub |
Partager