Fusion vers un document word

Le
Gen
Bonjour,

Je voudrais créer une macro en vba (excel) qui fusionnerait automatiquement
vers un document word (contenant déjà les bon noms de champs).

Est-ce que c'est possible ?

Merci !
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #4493141
Un message paru ici même paru sous la plume de Hervé :
à partir duquel tu peux t'inspirer pour bâtir ta macro !

Un copier-coller...
==================================================== En parlant de fusion, tu veux dire publipostage ? je n'est pas grande
connaissance de Word mais tu pourrais passer par l'intermédiaire d'un
document qui te servirait de base de données ? Regarde ceci, je l'ai posté
il y a quelques temps pour quelqu'un qui ne mas jamais dit si cela lui
convenait ??? La macro crée un tableau dans un nouveau document comme base
de données pour un publipostage et ensuite crée un document principal pour
le publipostage. Fait un test si cela te convient et adapte. La liaison DDE
est une liaison tardive.


Sub Publipostage()
Dim AppWord As Object
Dim I As Integer
Dim FE As Worksheet
Dim PlageTitre As Excel.Range

Set FE = Worksheets("Feuil1")
Set AppWord = CreateObject("Word.Application")

CreerListe AppWord, FE

With AppWord
.Documents.Add
With .Selection
.ParagraphFormat.Alignment = 1
With .Font
.Name = "Arial"
.Bold = True
.Size = 16
End With
.TypeText "Circulaire"
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = 0
With .Font
.Name = "Times New Roman"
.Bold = False
.Size = 10
End With
End With

Set PlageTitre = FE.Range(FE.[A2], FE.[IV2].End(xlToLeft))

With .Documents(1)
With .MailMerge
.MainDocumentType = 3 'wdCatalog
.OpenDataSource Name:=ThisWorkbook.Path & "ListeNoms.doc"
Set PlageTitre = FE.Range(FE.[B1], FE.[IV1].End(xlToLeft))
With .Fields
.Add AppWord.Selection.Range, PlageTitre(1)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(2)
AppWord.Selection.TypeParagraph
.Add AppWord.Selection.Range, PlageTitre(3)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(4)
AppWord.Selection.TypeParagraph
.Add AppWord.Selection.Range, PlageTitre(5)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(6)
End With
End With
End With

With .Selection
.TypeParagraph
.TypeParagraph
.TypeText "Ici ton texte..."
End With
.Visible = True
End With

Set AppWord = Nothing
Set FE = Nothing
Set PlageTitre = Nothing

End Sub

Sub CreerListe(AppWord As Object, _
FE As Worksheet)
Dim Doc As Object
Dim TableWd As Object
Dim Ligne As Object
Dim CelWD As Object

Dim Plage As Excel.Range
Dim CelXL As Excel.Range
Dim I As Integer
Dim NbCol As Integer
Dim NbLgn As Integer

Set Plage = FE.Range(FE.[B1], FE.[B65536].End(xlUp))

On Error Resume Next
Kill ThisWorkbook.Path & "ListeNoms.doc"
On Error GoTo 0

With Application.WorksheetFunction
NbCol = .CountIf(FE.Rows(1), "*")
NbLgn = .CountIf(FE.Columns(1), "*")
End With

With AppWord
Set Doc = .Documents.Add
With Doc
Set TableWd = .Tables.Add(.Range, NbLgn, NbCol - 1, 1, 1)
With TableWd
For Each CelXL In Plage
If CelXL <> "" Then
I = I + 1
.Cell(I, 1).Range.Text = Trim(CelXL.Text)
.Cell(I, 2).Range.Text = Trim(CelXL.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(CelXL.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(CelXL.Offset(0, 3).Text)
.Cell(I, 5).Range.Text = Trim(CelXL.Offset(0, 4).Text)
.Cell(I, 6).Range.Text = Trim(CelXL.Offset(0, 5).Text)
End If
Next CelXL
.Rows(1).Range.Bold = True
End With
.SaveAs ThisWorkbook.Path & "ListeNoms.doc"
.Close
End With
End With

Set Doc = Nothing
Set TableWd = Nothing
Set Ligne = Nothing
Set CelWD = Nothing
Set Plage = Nothing
Set CelXL = Nothing

End Sub
====================================================


"Gen"
Bonjour,

Je voudrais créer une macro en vba (excel) qui fusionnerait automatiquement
vers un document word (contenant déjà les bon noms de champs).

Est-ce que c'est possible ?

Merci !
Gen
Le #4493011
Bonjour,

Pour le moment ça semble être un excellente piste ! Je vais voir ce que je
peux faire avec votre code. Merci !




Un message paru ici même paru sous la plume de Hervé :
à partir duquel tu peux t'inspirer pour bâtir ta macro !

Un copier-coller...
==================================================== > En parlant de fusion, tu veux dire publipostage ? je n'est pas grande
connaissance de Word mais tu pourrais passer par l'intermédiaire d'un
document qui te servirait de base de données ? Regarde ceci, je l'ai posté
il y a quelques temps pour quelqu'un qui ne mas jamais dit si cela lui
convenait ??? La macro crée un tableau dans un nouveau document comme base
de données pour un publipostage et ensuite crée un document principal pour
le publipostage. Fait un test si cela te convient et adapte. La liaison DDE
est une liaison tardive.


Sub Publipostage()
Dim AppWord As Object
Dim I As Integer
Dim FE As Worksheet
Dim PlageTitre As Excel.Range

Set FE = Worksheets("Feuil1")
Set AppWord = CreateObject("Word.Application")

CreerListe AppWord, FE

With AppWord
.Documents.Add
With .Selection
.ParagraphFormat.Alignment = 1
With .Font
.Name = "Arial"
.Bold = True
.Size = 16
End With
.TypeText "Circulaire"
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = 0
With .Font
.Name = "Times New Roman"
.Bold = False
.Size = 10
End With
End With

Set PlageTitre = FE.Range(FE.[A2], FE.[IV2].End(xlToLeft))

With .Documents(1)
With .MailMerge
.MainDocumentType = 3 'wdCatalog
.OpenDataSource Name:=ThisWorkbook.Path & "ListeNoms.doc"
Set PlageTitre = FE.Range(FE.[B1], FE.[IV1].End(xlToLeft))
With .Fields
.Add AppWord.Selection.Range, PlageTitre(1)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(2)
AppWord.Selection.TypeParagraph
.Add AppWord.Selection.Range, PlageTitre(3)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(4)
AppWord.Selection.TypeParagraph
.Add AppWord.Selection.Range, PlageTitre(5)
AppWord.Selection.TypeText " "
.Add AppWord.Selection.Range, PlageTitre(6)
End With
End With
End With

With .Selection
.TypeParagraph
.TypeParagraph
.TypeText "Ici ton texte..."
End With
.Visible = True
End With

Set AppWord = Nothing
Set FE = Nothing
Set PlageTitre = Nothing

End Sub

Sub CreerListe(AppWord As Object, _
FE As Worksheet)
Dim Doc As Object
Dim TableWd As Object
Dim Ligne As Object
Dim CelWD As Object

Dim Plage As Excel.Range
Dim CelXL As Excel.Range
Dim I As Integer
Dim NbCol As Integer
Dim NbLgn As Integer

Set Plage = FE.Range(FE.[B1], FE.[B65536].End(xlUp))

On Error Resume Next
Kill ThisWorkbook.Path & "ListeNoms.doc"
On Error GoTo 0

With Application.WorksheetFunction
NbCol = .CountIf(FE.Rows(1), "*")
NbLgn = .CountIf(FE.Columns(1), "*")
End With

With AppWord
Set Doc = .Documents.Add
With Doc
Set TableWd = .Tables.Add(.Range, NbLgn, NbCol - 1, 1, 1)
With TableWd
For Each CelXL In Plage
If CelXL <> "" Then
I = I + 1
.Cell(I, 1).Range.Text = Trim(CelXL.Text)
.Cell(I, 2).Range.Text = Trim(CelXL.Offset(0, 1).Text)
.Cell(I, 3).Range.Text = Trim(CelXL.Offset(0, 2).Text)
.Cell(I, 4).Range.Text = Trim(CelXL.Offset(0, 3).Text)
.Cell(I, 5).Range.Text = Trim(CelXL.Offset(0, 4).Text)
.Cell(I, 6).Range.Text = Trim(CelXL.Offset(0, 5).Text)
End If
Next CelXL
.Rows(1).Range.Bold = True
End With
.SaveAs ThisWorkbook.Path & "ListeNoms.doc"
.Close
End With
End With

Set Doc = Nothing
Set TableWd = Nothing
Set Ligne = Nothing
Set CelWD = Nothing
Set Plage = Nothing
Set CelXL = Nothing

End Sub
==================================================== >


"Gen"
Bonjour,

Je voudrais créer une macro en vba (excel) qui fusionnerait automatiquement
vers un document word (contenant déjà les bon noms de champs).

Est-ce que c'est possible ?

Merci !





Publicité
Poster une réponse
Anonyme