Bonjour,

Je suis arrivé enfin à la phase finale de mon projet , qui consiste à transférer un tableau de résultat finale vers word .

cette fois ci je ne vais pas te poser la question nue mais je joint avec ce poste un code que j'ai développer et qui consiste à transféer une selection vers une page word vierge et je joint aussi le fichier excel contenant le tableau à transférer.

bon; ce qui est demandé ,c'est de transférer le tableau 16colonne par 16 colonne et si le nombre de colonne n'est pas un multiple de 16 , la derniére copie seras le reste des colonne .

mais on devrais repecter :

*reopier au début de chaque tableau la labell ( premiére colonne du tableau principale )

*garder un ecart de ( deux saut de ligne ) entre chaque tableau et autre.

*titré chaque tableau de "Résultat 1" à "Résultat N"

Merci beaucoup d'avance, je suis hyper heureux d'avoir arriver à ce stade et plus heureux d'explorer ce monde de programmation.

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
 
Private Sub CommandButton1_Click()
 
Application.ScreenUpdating = False
 
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim Fichier As String
    Dim A As Variant
 
 
 
 
    A = Application.GetOpenFilename()
 
 
    'le document Word est supposé fermé avant le lancement de la macro
    Fichier = "A"
 
    ' Si Le fichier n'est pas selectionné "msgbox" :D
 
    If A = False Then
    MsgBox " Aucun fichier n'a été selectionné"
 
Else
 
'necessite d'activer la reference Microsoft Word xx.x Object Library
 
Set WordApp = New Word.Application
 
WordApp.Visible = True
 
Set WordDoc = WordApp.Documents.Open(A)
 
 
'//////////////////////////////copie
 
 
Dim P As Range
Dim j As Variant
 
j = 0
On Error Resume Next
R:     Set P = Application.InputBox("Sélectionnez Le tableau" & j + 1 & "à exporter :", Type:=8)
 
    P.Copy
 
    WordApp.Selection.PasteSpecial
 
    WordDoc.Selection.End
 
    WordApp.Selection.InsertBreak Type:=1
    j = j + 1
 
    If j = 2 Then GoTo f Else: GoTo R
    On Error GoTo 0
 
f:
 
'////////////////////////////
 
For i = 1 To WordDoc.Tables.Count
 
WordDoc.Tables(i).AutoFitBehavior wdAutoFitWindow
WordDoc.Tables(i).Select
Selection.VerticalAlignment = wdCellAlignVerticalCenter
 
Next i
 
 
 
Application.CutCopyMode = True
 
    WordDoc.Close
 
    'ferme l'application Word
 
    WordApp.Quit
 
End If
 
 
 
    Sheets(1).Select
    ActiveSheet.Range("A1").Select
    Sheets(3).Select
    ActiveSheet.Range("A1").Select
    Sheets(4).Select
    ActiveSheet.Range("A1").Select
 
End Sub