Extraire des données depuis Excel vers Word

Version imprimable

Bonjour à la communauté.
J'ai un classeur Excel avec le nom des polices installées (colonne A) et un texte "exemple" (colonne B) avec la police nommée en colonne A.
En colonne C, j'ai le type de police (imprimerie, manuscrite, symbolique...).
J'essai de faire un document Word depuis cette liste, avec un Document par type de police.
J'ai lu attentivement "VBA Excel - Transférer des données d'excel vers Word", mais j'aimerais éviter d'utiliser le référencement de la bibliothèque Word, car mes macros vont être utilisées sur différents PC avec différentes versions de Word (et probablement d'Excel).
J'arrive à lancer Word, mais pour le reste, il ne se passe rien et je n'ai aucun retour d'erreur.
Voici ma tentative de code :
Code:

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 Sub ExportWord(Filtre As String) Application.ScreenUpdating = False Application.EnableEvents = False Dim WordApp As Object Dim DocWord As Object On Error Resume Next Set WordApp = CreateObject("Word.Application") Set DocWord = WordApp.Documents.Add WordApp.Visible = True WordApp.DisplayAlerts = False Debug.Print "--------------------" DocWord.Activate Lign = 2 Do While Cells(Lign, 1).Value <> "" Debug.Print Cells(Lign, 1).Value With DocWord.Selection .InsertBefore = Cells(Lign, 1).Value .Font.Name = “Arial” .typetext vbCrLf .InsertBefore = "Ex : servez un whisky au juge blond qui fume la pipe" .Font.Name = Cells(Lign, 1).Value .MoveStartUntil vbTab .MoveDown wdParagraph, 1 End With Lign = Lign + 1 Loop Set DocWord = Nothing Cells(2, 1).Activate Application.ScreenUpdating = True Application.EnableEvents = True MsgBox "Fin" End Sub
Si quelqu'un a une astuce, un conseil... je suis preneur.
Bien à toi la communauté.
Denis...

22/10/2023, 15h54
Philippe Tulliez

Bonjour,

Citation:

j'aimerais éviter d'utiliser le référencement de la bibliothèque Word, car mes macros vont être utilisées sur différents PC avec différentes versions de Word (et probablement d'Excel).

Pour cela il faut utiliser le Late Binding
Tout en bas du billet que vous avez lu, je renvoie vers des tutoriels dont le billet titré VBA Excel - La compilation conditionnelle ou comment développer en EarlyBinding et distribuer en late binding

Citation:

J'arrive à lancer Word, mais pour le reste, il ne se passe rien et je n'ai aucun retour d'erreur.

C'est tout à fait normal que vous n'ayez pas de message d'erreur puisqu'en ligne 7, vous avez utilisez On Error Resume Next

Bonjour Philippe, et un grand merci pour cette réponse.
Tout fonctionne très bien. Pour ce qui est d'écrire dans le document.
Mais les polices ne se forment pas là où il faudrait.
J'ai tenté de changer l'ordre des ".Font.Name" et des ".TypeText", mais rien n'y fait.
Code:

1 2 3 4 5 6 7 8 With appWrd.Selection .Font.Name = “Arial” .Typetext Text:=Cells(Lign, 1).Value & " : " 'Nom de la police .TypeParagraph .Typetext Text:="Ex : servez un whisky au juge blond qui fume la pipe" 'Exemple de la police .Font.Name = Cells(Lign, 1).Value .TypeParagraph End With
Je ne sais pas trop quoi faire pour l'instant, mais je continu de chercher.
En tous cas, mille mercis pour votre aide.
Denis...

22/10/2023, 17h48
Philippe Tulliez
Bonjour Denis,
Il y a plusieurs problèmes dans la procédure que vous avez publiée. J'ai évidemment avant tout supprimé la ligne 7 qui empêche de détecter les erreurs
1. La procédure nommé ExportWord a un argument nommé Filtre or vous n'utilisez pas cet argument et en tant que telle la procédure ne peut qu'être invoquée depuis une autre procédure. J'ai donc supprimer cet argument.
2. Vous n'avez pas déclaré la variable Lign
3. Les guillemets qui entoure "Arial" ne sont pas correct (vous avez écrit “Arial” et c'est "Arial")
4. vous utilisez des constantes Word celle préfixées wd or lorsque l'on ne référence pas la bibliothèque Word. VBA ne connait pas ces constantes donc soit vous déclarez ces constantes dans la procédure soit vous utilisez leurs valeurs (wdParagraph est égal à 4)
5. il est fortement indiqué de préciser la parentalité des cellules (feuille + classeur) au risque de lire les valeurs de cellules d'une autre feuille (celle qui est active)
6. pendant la phase de test, il est préférable de conserver Application.ScreenUpdating à True. Pourquoi cette ligne Application.EnableEvents = False
Pouvez-vous publier le contenu des paramètres que vous avez placé dans les cellules d'excel ?
Dans l'article que vous avez lu, je préconise l'usage des signets ce qui vous éviterait de placer les paramètres (Taille, Police, etc;) dans Excel. Un document Word est fait pour cela.
22/10/2023, 18h21
DenisHen

1 pièce(s) jointe(s)

Rebonjour Philippe, et merci de m'aider.
Effectivement, je n'ai juste posté qu'une infime partie de mon code, je ne voulais pas décourager le lecteur.
Je n'ai qu'un classeur (.xlsm) d'une seule feuille, qui pourras faire plusieurs centaines de lignes, voir beaucoup plus.
Bravo pour les guillemets, je n'avais rien vu.
Je fais actuellement les autres modifications que vous m'avez indiquées ainsi que des recherches sur les "wd" sans bibliothèque.
Encore merci à vous.

Voici une capture partielle de mon classeur :

Pièce jointe 645567
Denis...

Bonjour Denis,
Voici une petite procédure qui utilise deux fontes de polices avec des tailles différentes lors de l'écriture de deux phrases dans un nouveau document.

Code:

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
Sub t()
 Dim objWord As Object
 Set objWord = CreateObject("Word.Application")
 With objWord
 .Visible = True ' Affiche Word
 .Documents.Add  'Ajoute un document
 End With
 '
 With objWord.Selection
 .TypeParagraph
  With .Font
  .Name = "Calibri": .Size = 24
  End With
 .TypeText Text:="Procédure pour écrire dans Word "
 .TypeParagraph
  With .Font
  .Name = "Arial": .Size = 11
  End With
 .TypeText Text:="Hello World :o)"
 .InsertBreak Type:=7 ' Saut de page (7 = constante wdPageBreak)
 End With
 ' objWord.PrintOut   ' imprimer le document
 Set objWord = Nothing
End Sub
Sub ControleSiDocumentWordOuvert()

Bonjour Philippe.
Merci pour cet exemple efficace, j'ai (presque) pu faire ce que je voulais (reste juste une mise en page à faire : pied de page, marges...).
A toutes fins utiles, voici mon code final :
Appel de la procédure depuis le ruban :

Code:

1
2
3
Sub FavSymbWord(control As IRibbonControl)
    ExportWord ("S")
End Sub

Procédure InitValeur :

Code:

1
2
3
4
5
6
7
Sub InitValeur()
    Set LstStyle = New Collection
    LstStyle.Add "Imprimerie", "I"
    LstStyle.Add "Manuscrit", "M"
    LstStyle.Add "Symbole", "S"
    LstStyle.Add "Décoratif", "D"
End Sub

Procédure principale :

Code:

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Sub ExportWord(Filtre As String)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    InitValeur
    Dim Lign As Integer
    Dim MyDate As String
 
    Annee = Format(Now, "yyyy")
    Mois = Format(Now, "mmmm")
    Jour = Format(Now, "dd")
    JourLong = Format(Now, "Dddd")
    Heure = Format(Now, "HH")
    Minutes = Format(Now, "mm")
    'Secondes = Format(Now, "ss")
    MyDate = "Fait le " & JourLong & " " & Jour & " " & Mois & " " & Annee & " à " & Heure & "h" & Minutes
    If Filtre <> "" Then FiltreSel = LstStyle.Item(Filtre) Else FiltreSel = ""
    Dim AppWord As Object
    Dim DocWord As Object
    Set AppWord = CreateObject("Word.Application")
    Compt = 1
    With AppWord: .Visible = True: .Activate: End With
    Set DocWord = AppWord.Documents.Add
    DocWord.Sections(1).Footers(1).Range.Text = MyDate
    DocWord.Sections(1).Footers(1).Range.ParagraphFormat.Alignment = 1
    With AppWord.Selection.PageSetup
        .LeftMargin = 15
        .RightMargin = 15
        .TopMargin = 20
        .BottomMargin = 30
    End With
    ' Ecriture dans le nouveau document Word
    With AppWord.Selection
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .Font.Name = "Arial"
        .Font.Bold = True
        .Font.Size = 40
        .ParagraphFormat.Alignment = 1
        .typetext Text:="Liste des polices."
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
    End With
    If FiltreSel <> "" Then
        With AppWord.Selection
            .Font.Name = "Arial"
            .Font.Underline = 1
            .Font.Bold = True
            .Font.Italic = True
            .Font.Size = 25
            .ParagraphFormat.Alignment = 1
            .typetext Text:="Type : " & FiltreSel
            .TypeParagraph
        End With
    End If
    With AppWord.Selection
        .TypeParagraph
        .TypeParagraph
        .TypeParagraph
        .Font.Name = "Arial"
        .Font.Bold = False
        .Font.Italic = True
        .Font.Underline = 0
        .Font.Size = 10
        .ParagraphFormat.Alignment = 1
        .typetext Text:="Développé par DenisH"
        .TypeParagraph
        .typetext Text:="(hennuyer.denis@gmail.com)"
        .TypeParagraph
        .TypeParagraph
    End With
    ' Saut de page
    AppWord.Selection.InsertBreak Type:=7
    Lign = 2: Compt = 1
    Do While Cells(Lign, 1).Value <> ""
        If FiltreSel = Cells(Lign, 3).Value Or Filtre = "" Then
            If Filtre = "" Then
                Texte = Cells(Lign, 1).Value & " (" & Cells(Lign, 3).Value & ") : "
            Else
                Texte = Cells(Lign, 1).Value & " : "
            End If
            With AppWord.Selection
                .Font.Name = "Arial"
                .Font.Size = 12
                .Font.Underline = 1
                .Font.Italic = False
                .ParagraphFormat.Alignment = 0
                .Font.Bold = True
                .typetext Text:=Texte
                .TypeParagraph
            End With
            With AppWord.Selection
                .Font.Name = Cells(Lign, 1).Value
                .Font.Bold = False
                .Font.Underline = 0
                .typetext Text:="Ex : servez un whisky au juge blond qui fume la pipe"
                .TypeParagraph
            End With
        End If
        Lign = Lign + 1
        Compt = Compt + 1
        ' Limite l'export à 30 polices
        If Compt > 30 Then GoTo Fin
    Loop
Fin:
    Set AppWord = Nothing: Set DocWord = Nothing
    Cells(2, 1).Activate
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "Exportation dans Word terminée.", vbInformation
End Sub

Ce code ne doit pas être très "beau" pour les pro, mais je ne sais pas faire "mieux" ;)
Encore mille mercis Philippe, j'en ai appris encore un peu plus aujourd'hui, mais le chemin est encore long ;)
Très cordialement.
Bien à toi, la communauté.
Denis...