Discussion :

[Matrixmax]

Bonjour ,

J'ai essayé d'utilisé mais çà n'as pas marché et j'en suis sure que j'ai fais une erreur quelque part .. :/ .. il me manque quelque chose :/
Merci de me voir ce ptit bout de code .. il bug au niveau de ligne de transfert !

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
 
 
 
Private Sub exp()
 
 
 
    Const expo As String = "Exporter vers word"
    Const synt As String = "synthése"
    Dim Cr, Cl, Cu, Cd As Integer
 
 
 
 
    Cr = Sheets(synt).Cells(12, 2).End(xlToRight).Column
    With Sheets(expo)
 
    .Range(Cells(6, 2), Cells(7, Cr)).Value = Sheets(synt).Range(Cells(12, 2), Cells(13, Cr)).Value
    End With
    End

.. merci d'avance !

[mercatog]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Expd()
Const Expo As String = "Exporter vers word"
Const Synt As String = "synthése"
Dim Cr As Integer
 
Cr = Worksheets(Synt).Cells(12, 2).End(xlToRight).Column
With Worksheets(Expo)
    .Range(.Cells(6, 2), .Cells(7, Cr)).Value = Worksheets(Synt).Range(Worksheets(Synt).Cells(12, 2), Worksheets(Synt).Cells(13, Cr)).Value
    'ou bien
    '.Range("B6").Resize(2, Cr - 1).Value = Worksheets(Synt).Range("B12").Resize(2, Cr - 1).Value
End With
End Sub

[Matrixmax]

Bonjour,

Je suis arrivé enfin à la phase finale de mon projet , qu iconsiste à transférer le 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.

or 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.

et c'est grace à dieu puii toi Mercatog !!

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