Discussion :

[Yanou20]

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 :
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !