Bonjour tout le monde,
Je bloque depuis un moment sur quelque chose qui me semble simple mais je n'arrive pas à trouver de solution. Je fais donc appel à vos lumières.
J'ai compilé un code qui me permet en fonction du nombre de feuille sur un fichier Excel de copier sur un Word sous format paysage des tableaux des feuilles nommées de 1 à beaucoup. Ce sont ces tableaux qui m'intéressent avec un saut de page entre chaque tableau copié. Cela me permet de faire une synthèse rapide sur Word.
Il n'y a pas de problème et le code fonctionne bien. Le seul hic c'est lors de la copie, Word met automatiquement un espacement "après" de 8pt, ce qui fait que le tableau dépasse de la feuille Word. J'avais réalisé le tableau de façon à ce qu'il prenne tout l'espace d'une page Word. Un copier - coller basique fonctionne très bien car il ne m'insère pas cet espacement.
J'ai essayé d'utiliser l'enregistrement de code de Word pour l'importer dans mon code Excel mais ça ne marche pas. Je pense que je passe à coté de quelque chose mais je ne vois pas.
Voici le code, que j'ai mis en place :
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 Public Const wdOrientLandscape = 1 Public Const wdSectionBreakNextPage = 2 Sub Export_word() Dim WordApp As Object, WordDoc As Object Dim nbf As Long nbf = ActiveWorkbook.Sheets.Count Dim i As Integer i = 0 On Error Resume Next Set WordApp = CreateObject("Word.Application") WordApp.Visible = True Set WordDoc = WordApp.Documents.Add WordDoc.PageSetup.Orientation = wdOrientLandscape While i < nbf - 9 Sheets(i + 3).Select With WordApp.Selection Sheets(i + 3).Range("R2:T22").Copy .Paste .InsertBreak Type:=wdSectionBreakNextPage End With i = i + 1 Wend '---------- Partie du code qui ne fonctionne pas------------------ With WordApp.Selection.WholeStory .SpaceBeforeAuto = False .SpaceAfter = 0 .SpaceAfterAuto = False .LineUnitAfter = 0 End With '---------- Partie du code qui ne fonctionne pas------------------ Sheets("Typologie").Select Application.CutCopyMode = False Set WordDoc = Nothing Set WordApp = Nothing MsgBox "Export Word Ok", , "Succès" End Sub
J'espère avoir été clair dans ma demande. Je vous remercie par avance pour votre temps et pour vos futures réponses.
Bien cordialement,
Rofou13
Partager