Fusion vers un document word

Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Entraide Applications Microsoft Office Excel Fusion vers un document word

2 réponses

Gen

08/05/2007 à 16:54

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 !

2 réponses

MichDenis

08/05/2007 à 22:02

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" a écrit dans le message de news:

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 !

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" <Gen@discussions.microsoft.com> a écrit dans le message de news:
2C003BB1-B0B4-4A97-A73E-1D6DBD74CA72@microsoft.com...
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 !

Vous avez filtré cet utilisateur ! Consultez son message

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" a écrit dans le message de news:

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

08/05/2007 à 22:55

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" a écrit dans le message de news:

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 !

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" <Gen@discussions.microsoft.com> a écrit dans le message de news:
2C003BB1-B0B4-4A97-A73E-1D6DBD74CA72@microsoft.com...
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 !

Vous avez filtré cet utilisateur ! Consultez son message

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" a écrit dans le message de news:

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 !

Fusion vers un document word

2 réponses

Veuillez sélectionner un problème