1 pièce(s) jointe(s)
Copier tableau Excel vers Word
Bonjour, :)
Je suis bloquée depuis déjà un moment sur mon code VBA, en espérant que quelqu'un aura la solution !
Ce que je veux faire : Pièce jointe 660472
Réaliser un lien entre un document Excel et Word.
L'idée serait de copier automatiquement le tableau excel dans une page word indiquée en cellule S3 (le tableau se copierai dès que S3 est modifié et validé, comme ça la même trame de tableau me permet d'en réaliser plusieurs)
Ce que mon code me fait : Le tableau ne se copie pas et peu importe le nombre de page sur mon Word, elles sont automatiquement supprimées pour n'en garder que 2.
Voilà mon code de Module1 :
Code:
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
| Dim wordApp As Object
Dim wordDoc As Object
Dim ws As Worksheet
Dim rng As Range
Dim isWordInitialized As Boolean
Sub InitializeWord()
' Essaye d'obtenir l'instance Word en cours
On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
On Error GoTo 0
If wordApp Is Nothing Then
MsgBox "Aucune instance de Word n'est ouverte. Veuillez ouvrir un document Word.", vbExclamation
Exit Sub
End If
' Assure-toi que le document actif est bien celui que tu veux utiliser
Set wordDoc = wordApp.ActiveDocument
If wordDoc Is Nothing Then
MsgBox "Aucun document actif trouvé dans Word.", vbExclamation
Exit Sub
End If
wordApp.Visible = True
isWordInitialized = True
End Sub
Sub CopyTableToWord()
' Référence à la feuille contenant le tableau
Set ws = ThisWorkbook.Sheets("Nombres Patients")
' Définit la plage à copier (ajuste selon tes besoins)
Set rng = ws.Range("A1:M17") ' Change "A1:M17" selon ta plage de données
' Vérifie si la plage est vide
If Application.WorksheetFunction.CountA(rng) = 0 Then
MsgBox "La plage à copier est vide.", vbExclamation
Exit Sub
End If
' Récupère la page spécifiée dans la cellule S3
Dim pageNum As Long
pageNum = ws.Range("S3").Value
' Vérifie le nombre de pages dans le document
Dim currentPage As Long
On Error Resume Next
currentPage = wordDoc.ComputeStatistics(2) ' 2 = wdStatisticPages
On Error GoTo 0
' S'assurer que le document a suffisamment de pages
If pageNum > currentPage Then
For i = currentPage To pageNum - 1
wordDoc.Content.InsertBreak Type:=7 ' wdPageBreak
Next i
End If
' Déplace le curseur à la page spécifiée
wordDoc.GoTo What:=1, Which:=1, Count:=pageNum ' 1 = wdGoToPage, 1 = wdGoToAbsolute
' Copie le tableau et le colle dans Word
rng.Copy
wordDoc.Content.PasteSpecial DataType:=wdPasteRTF ' Colle comme RTF (rich text format)
' Insérer un saut de page après chaque tableau
wordDoc.Content.InsertBreak Type:=7 ' wdPageBreak
End Sub |
Et voici le code de ma première feuille :
Code:
1
2
3
4
5
6
7
8
9
10
| Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("S3")) Is Nothing Then
If Target.Value <> "" Then ' Vérifie si S3 n'est pas vide
If Not isWordInitialized Then
Call InitializeWord
End If
Call CopyTableToWord
End If
End If
End Sub |
Merci beaucoup d'avance !
