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
|
Private Sub ExporterFeuillesVersWord()
' Exporte les feuilles sélectionnées vers Word
Dim ObjWord As Object 'Word.Application
Dim WordDoc As Object 'Word.Document
Dim WordSelect As Object 'Word.Selection
Dim Feuille As Worksheet
Dim I As Integer
Dim Cell As Range
Dim Contenu As String
' Vérifier si Word est ouvert
On Error Resume Next
Set ObjWord = GetObject(, "Word.Application")
On Error GoTo 0
If ObjWord Is Nothing Then
' Si Word n'est pas déjà ouvert, le démarrer
Set ObjWord = CreateObject("Word.Application")
ObjWord.Visible = True ' Vous pouvez changer cela en fonction de vos besoins
End If
Set WordDoc = ObjWord.Documents.Add
Set WordSelect = ObjWord.Selection
' Exporter chaque feuille sélectionnée vers Word
For I = 0 To ListBoxFeuilles.ListCount - 1
If ListBoxFeuilles.Selected(I) Then
Set Feuille = ThisWorkbook.Sheets(ListBoxFeuilles.List(I))
' Construire le contenu à partir des cellules de la feuille
For Each Cell In Feuille.UsedRange
Contenu = Contenu & Cell.Value & vbTab ' Utilisez un tableau pour séparer les cellules
Next Cell
With WordSelect
.Text = Contenu
.InsertParagraphAfter
.EndKey unit:=6, Extend:=0
If CheckBoxSautDePage Then .InsertBreak Type:=7
End With
Contenu = "" ' Réinitialiser le contenu
Set Feuille = Nothing
End If
Next I
' Nettoyer
Set ObjWord = Nothing: Set WordDoc = Nothing: Set WordSelect = Nothing
Unload Me
End Sub |
Partager