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