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 |
