Microsoft 365 Générer un word

D

Drimo_8885

XLDnaute Nouveau
Bonjour,
J'ai le fichier joint comme exemple (ma BD est plus conséquente) et j'aimerais une macro qui puisse me générer un word pour chaque étudiant comportant juste les colonnes (matière; note et coeff) avec le nombre exacte de ligne pour chacun.
La prémière colonne nom devant servir à nommer le word en question. Est-ce faisable ?
Merci pour vos retours !
Drimo.
 

Pièces jointes

  • Generer word.xlsx
    10.8 KB · Affichages: 10
Trier par date Trier par votes
sousou

sousou

XLDnaute Barbatruc
Bonjour.
Voici un début de réponse à adapter.
Ci-joint un dossier comprenant ton fichier avec la macro ('carte') cherche pas pour le nom!
et un fichier word vierge

Le tout à mettre au point, j'ai simplifié au max en fonction de ton exemple
 

Pièces jointes

  • Genererword.zip
    18.3 KB · Affichages: 6
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir Drimo_8885, sousou,

A mon avis il est mieux de générer des fichiers PDF :
VB: 
Sub PDF()
Dim chemin$, d As Object, i&, a
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---zone d'impression et zoom---
    .Parent.PageSetup.PrintArea = .Address
    .Parent.PageSetup.Zoom = 200
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers PDF---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque la colonne
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .ExportAsFixedFormat xlTypePDF, chemin & a(i) & ".pdf"
    Next
    .Columns(1).Hidden = False 'affiche la colonne
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
End With
End Sub
A+
 

Pièces jointes

  • Generer PDF(1).xlsm
    20.3 KB · Affichages: 7
Vote positif 0 Vote négatif
D

Drimo_8885

XLDnaute Nouveau
sousou à dit:
Bonjour.
Voici un début de réponse à adapter.
Ci-joint un dossier comprenant ton fichier avec la macro ('carte') cherche pas pour le nom!
et un fichier word vierge

Le tout à mettre au point, j'ai simplifié au max en fonction de ton exemple
Cliquez pour agrandir...
Bonsoir Sousou,

Merci énormément pour ta réponse ! ça a fonctionné sur mon exemple, je vais l'adapter à ma BD !

Bonne soirée !
 
Vote positif 0 Vote négatif
D

Drimo_8885

XLDnaute Nouveau
job75 à dit:
Bonsoir Drimo_8885, sousou,

A mon avis il est mieux de générer des fichiers PDF :
VB: 
Sub PDF()
Dim chemin$, d As Object, i&, a
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---zone d'impression et zoom---
    .Parent.PageSetup.PrintArea = .Address
    .Parent.PageSetup.Zoom = 200
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers PDF---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque la colonne
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .ExportAsFixedFormat xlTypePDF, chemin & a(i) & ".pdf"
    Next
    .Columns(1).Hidden = False 'affiche la colonne
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
End With
End Sub
A+
Cliquez pour agrandir...
Bonsoir Job75,

Merci énormément, c'est encore mieux en pdf oui !

Bonne soirée !
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Oui maintenant ça va sousou.

Mais on peut aussi appliquer la même méthode de filtrage que pour les fichiers PDF :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .Copy 'copier
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        With Wapp.Documents.Add
            .Content.Paste 'coller
            .Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
            .SaveAs chemin & a(i) & ".docx"
        End With
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
 

Pièces jointes

  • Generer Word(1).xlsm
    21.4 KB · Affichages: 2
Vote positif 0 Vote négatif
D

Drimo_8885

XLDnaute Nouveau
job75 à dit:
Oui maintenant ça va sousou.

Mais on peut aussi appliquer la même méthode de filtrage que pour les fichiers PDF :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .Copy 'copier
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        With Wapp.Documents.Add
            .Content.Paste 'coller
            .Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
            .SaveAs chemin & a(i) & ".docx"
        End With
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
Cliquez pour agrandir...
Bonjour Job75,

Cette dernière version me va parfaitement.
J'aimerais juste rajouter un titre au tableau généré qui sera en haut du tableau et souligné et qui portera aussi le nom de l'élève.

Merci déjà beaucoup à vous pour ce beau travail !
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Drimo_8885 à dit:
J'aimerais juste rajouter un titre au tableau généré
Cliquez pour agrandir...
Voyez ce fichier (2) et la macro complétée :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object, Wdoc As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        Set Wdoc = Wapp.Documents.Add
        Wdoc.Content = a(i) & vbLf
        Wdoc.Paragraphs(1).Range.Font.Bold = True 'gras
        Wdoc.Paragraphs(1).Range.Font.Underline = 1 'wdUnderlineSingle
        .Copy 'copier
        Wdoc.Paragraphs(2).Range.Paste 'coller
        Wdoc.Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
        Wdoc.SaveAs chemin & a(i) & ".docx"
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
 

Pièces jointes

  • Generer Word(2).xlsm
    21.2 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Contrairement à ce que je pensais la création du titre dans Word ne vide pas le presse-papiers.

Donc on peut mettre .Copy juste après le filtrage, c'est un peu plus simple; fichier (2 bis) :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .Copy 'copier
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        With Wapp.Documents.Add
            .Content = a(i) & vbLf
            .Paragraphs(1).Range.Font.Bold = True 'gras
            .Paragraphs(1).Range.Font.Underline = 1 'wdUnderlineSingle
            .Paragraphs(2).Range.Paste 'coller
            .Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
            .SaveAs chemin & a(i) & ".docx"
        End With
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
 

Pièces jointes

  • Generer Word(2 bis).xlsm
    21.3 KB · Affichages: 5
Vote positif 0 Vote négatif
D

Drimo_8885

XLDnaute Nouveau
job75 à dit:
Contrairement à ce que je pensais la création du titre dans Word ne vide pas le presse-papiers.

Donc on peut mettre .Copy juste après le filtrage, c'est un peu plus simple; fichier (2 bis) :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .Copy 'copier
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        With Wapp.Documents.Add
            .Content = a(i) & vbLf
            .Paragraphs(1).Range.Font.Bold = True 'gras
            .Paragraphs(1).Range.Font.Underline = 1 'wdUnderlineSingle
            .Paragraphs(2).Range.Paste 'coller
            .Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
            .SaveAs chemin & a(i) & ".docx"
        End With
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
Cliquez pour agrandir...
Bonsoir Job75,

Merci beaucoup, tu gères grave !

Excellente soirée à toi,
Drimo
 
Vote positif 0 Vote négatif
D

Drimo_8885

XLDnaute Nouveau
Drimo_8885 à dit:
Bonsoir Job75,

Merci beaucoup, tu gères grave !

Excellente soirée à toi,
Drimo
Cliquez pour agrandir...
job75 à dit:
Contrairement à ce que je pensais la création du titre dans Word ne vide pas le presse-papiers.

Donc on peut mettre .Copy juste après le filtrage, c'est un peu plus simple; fichier (2 bis) :
VB: 
Sub Word()
Dim chemin$, d As Object, i&, a, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
With [C2].CurrentRegion
    '---liste des noms sans doublon---
    For i = 2 To .Rows.Count
        d(.Cells(i, 1).Value) = ""
    Next
    If d.Count = 0 Then Exit Sub
    a = d.keys
    '---filtrage et création des fichiers Word---
    Application.ScreenUpdating = False
    .Columns(1).Hidden = True 'masque
    For i = 0 To UBound(a)
        .AutoFilter 1, a(i)
        .Copy 'copier
        If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application"): Wapp.Visible = True
        With Wapp.Documents.Add
            .Content = a(i) & vbLf
            .Paragraphs(1).Range.Font.Bold = True 'gras
            .Paragraphs(1).Range.Font.Underline = 1 'wdUnderlineSingle
            .Paragraphs(2).Range.Paste 'coller
            .Content.ParagraphFormat.SpaceBefore = 6 'cadrage vertical
            .SaveAs chemin & a(i) & ".docx"
        End With
        Application.CutCopyMode = 0
    Next
    .Columns(1).Hidden = False 'affiche
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    Wapp.Quit 'ferme Word
End With
End Sub
Cliquez pour agrandir...
Rebonjour Job75,


Désolé de revenir encore, mais finalement je veux que le titre porte le contenu d'une autre colonne autre que C2, j'ai bien rajouter une ligne de code mais ça ne fonctionne pas.


Encore merci !
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2016 Générer un rapport pdf depuis excel
Réponses
10
Affichages
655
fraux
F
M
  • Question
Autres Générer une étiquette pour imprimante thermique
Réponses
3
Affichages
203
fanch55
fanch55
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
311
job75
job75
M
  • Question
Microsoft 365 Générer un document word via excel
Réponses
1
Affichages
218
sousou
sousou
L
  • Question
Microsoft 365 Code VBA pour commencer publipostage à partir d'un .dotx
Réponses
5
Affichages
908
Law0179
L
oguruma
  • Question
Microsoft 365 https://outlook.live.com/ - appeler office.com et outlook pour générer un courriel
Réponses
2
Affichages
263
oguruma
oguruma
M
  • Question
Microsoft 365 Modifier la source de données dans un powerbi à partir d'une macro VBA
Réponses
3
Affichages
425
chris
chris
C
  • Question
XL 2021 Etat de sortie sur Word a partir d'une base Excel
Réponses
11
Affichages
580
cherco
C
kercroam
  • Question
XL 2021 Modifier une condition pour le calcul du bonus défensif pour un programme de rugby
2 3
Réponses
32
Affichages
940
djidji59430
djidji59430
L
  • Question
Microsoft 365 Comment reporter une valeur dans un onglet sans la répéter
Réponses
2
Affichages
332
L_PE
L

Membres actuellement en ligne

14 membres et 249 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 198
Messages
2 086 114
Membres
103 121
dernier inscrit
SophieS