Discussion :

[Matrixmax]

Bonjour chers forumistes ,



J'ai une dificulté à transférer un grand tableau excel ( ci-joint ) vers un nvx doc word , tout on respectant les régles suivante :

* couper le tableau en plusieurs tablette de 12 colonne chacune ( voir fichier joint)

* coller les tableaux l'un aprés l'autre on gardant la premiére colonne (contenant la signification de chaque ligne) toujours au début de chaque tableau

*Chaque tableau est l'enssemble des cellule depuis la ligne 3 et jusqu'à la ligne 26 et sa largeur et de 12 colonne + la premiére

*Le code doit etre placé dans la feuil excel contenant les tableau

* activer le fichier word et fermer le classeur excel

Le fichier joint contient le classeur excel contenant le tableau à recopier dans word et un exemple dans word de l'application faite manuellement .

Je suis vraiment bloqué et c'est à vous de m'aider comme d'habitude

Un grand merci d'avance !!

Voilà le code que j'ai développé en prmeir temps

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
 
 
Private Sub CommandButton1_Click()
 
    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)
 
 
ActiveSheet.Range("A3:P26").Select
 
Selection.Copy
 
WordApp.Activate
 
 
WordDoc.Paragraphs.Add
 
WordApp.Selection.PasteSpecial
 
ThisWorkbook.ActiveSheet.Select
 
ActiveSheet.Range("A3:A24,Q3:AG24").Select
Selection.Copy
 
 
Dim i As Variant
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
 
End Sub

[franc83]

Bonjour
Je viens de faire cela rapidement
A mettre dans le code de la feuille
-Mettre un BP "CommandButton1" dans la feuille
-De bien cocher dans Visual Outils/référence: microsoft word 12.0 objet library
-De mettre des signets dans tes feuilles word pour positionner les morceaux de tableau
A+ Franc

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
'cochez la référence Microsoft Word 12.0 Object Library
Private Sub CommandButton1_Click()
 
    Dim oWord As Word.Application
    'Créer une instance de word
   Set oWord = CreateObject("Word.Application")
 
'Copier une plage depuis Excel
 Range("B6:D21").Select
 
 Selection.Copy
 
'Ouvrir un nouveau document
 oWord.Documents.Open "D:\Document1.docx"
 
    'rendre le document word visible
    oWord.Visible = True
 
    'cherche le signet dans la feuille word
  oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet1"
 
  'Coller la plage dans Word
  oWord.Selection.PasteAndFormat (wdPasteDefault)
 
   'aligne le tableau au milieu de la page
  oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
 Range("E6:G21").Select
 Selection.Copy
 
  oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet2"
 
  oWord.Selection.PasteAndFormat (wdPasteDefault)
 
  oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
   Range("H6:J21").Select
 Selection.Copy
 
  oWord.Selection.GoTo What:=wdGoToBookmark, Name:="Signet3"
 
  oWord.Selection.PasteAndFormat (wdPasteDefault)
 
  oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
 
 'Annuler le mode couper/copier
Application.CutCopyMode = False
 
End Sub