Copier un texte multilignes avec mise en forme

[C60a]

Bonjour à tous,

Comment recopier, depuis Excel, un texte composé de plusieurs lignes, dans Word tout en gardant/reproduisant la mise en forme

Merci d'avance.

 

[job75]

Bonjour C60a, le forum,

Vous n'avez jamais essayé de faire un copier-coller manuel ? Il conserve la mise en forme.

Voyez le fichier joint et cette macro :

Sub CopierVersWord()
Dim wApp As Object
On Error Resume Next
Set wApp = GetObject(, "Word.Application") 'si Word est déjà ouvert
On Error GoTo 0
If wApp Is Nothing Then Set wApp = CreateObject("Word.Application")
wApp.Visible = True
With wApp.Documents.Add 'nouveau document
  .Range.Text = "Bonjour le forum," & vbLf & vbLf 'c'est plus poli
  [A5:B7].Copy
  .Paragraphs(3).Range.Paste
End With
Application.CutCopyMode = 0
End Sub

Bonne journée.

 

[job75]

Re,

Si l'on veut insérer des données dans un document Word existant il suffit d'y mettre des signets :

Sub CopierVersWord()
Dim wApp As Object
On Error Resume Next
Set wApp = GetObject(, "Word.Application") 'si Word est déjà ouvert
On Error GoTo 0
If wApp Is Nothing Then Set wApp = CreateObject("Word.Application")
wApp.Visible = True
With wApp.Documents.Add(ThisWorkbook.Path & "\Facture.docx")
  .Bookmarks("Signet1").Range.Text = Date
  [A5:B7].Copy
  .Bookmarks("Signet2").Range.Paste
End With
Application.CutCopyMode = 0
End Sub

Extrayez les 2 fichiers zippés joints dans le même répertoire pour tester.

A+

 

[job75]

Re,

Une petite cerise sur le gâteau.

Sur Excel le format Date mmmm aaaa ne permet pas de mettre une majuscule au nom du mois.

Mais si on veut l'obtenir dans Word :

Sub CopierVersWord()
Dim wApp As Object, i As Byte
On Error Resume Next
Set wApp = GetObject(, "Word.Application") 'si Word est déjà ouvert
On Error GoTo 0
If wApp Is Nothing Then Set wApp = CreateObject("Word.Application")
wApp.Visible = True
With wApp.Documents.Add(ThisWorkbook.Path & "\Facture.docx")
  .Bookmarks("Signet1").Range.Text = Date
  [A5:B7].Copy
  .Bookmarks("Signet2").Range.Paste
  With .Bookmarks("Signet2").Range.Find
    For i = 1 To 12
      .Replacement.ClearFormatting
      .Text = Format("1/" & i, "mmmm")
      .Replacement.Text = Application.Proper(Format("1/" & i, "mmmm"))
      .Execute Replace:=2 '2 => wdReplaceAll
    Next
  End With
End With
Application.CutCopyMode = 0
End Sub

Fichiers (3).

A+

 

[C60a]

Bonjour job75,

Merci pour tes réponses.

Je vais essayé de comprendre le code ensuite l'adapter !

@+

 

[C60a]

Re,

Comment peut-on aligner les deux points ( : ) devant DT, Do et Mois ?

 

[job75]

Bonjour C60a, le forum,

Comment peut-on aligner les deux points ( : ) devant DT, Do et Mois ?

C'est vraiment un détail, je vous laisse découvrir 2 solutions dans les fichiers (4) et (4 bis) zippés joints.

Bonne journée.

 

[C60a]

Bonsoir,

J'ai essayé d'adapter le code comme ceci :

Dim wd As Object, i As Byte
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")    'si Word est déjà ouvert
    On Error GoTo 0
    If wd Is Nothing Then Set wd = CreateObject("Word.Application")
    wd.Visible = True
    Dc = wd.Documents.Add(ThisWorkbook.Path & "\Rapport.docx")
    'Set Plg = Dc.Range
    With Dc
    ' Titre1 premier titre en haut de la page, centré verticalement, gras, 14pt et souligné
    ' Texte = "Rapport mensuel d'activités"
        With .Bookmarks("Titre1").Range
            .Text = Texte
            With Font
                .Size = 14
                .Bold = True
                .Underline = wdUnderlineSingle
            End With
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
        End With
        Sheets("1").[T1:U3].Copy
        .Bookmarks("Titre2").Range.Paste
        With .Bookmarks("Titre2").Range.Find
            For i = 1 To 12
                .Replacement.ClearFormatting
                .Text = Format("1/" & i, "mmmm")
                .Replacement.Text = Application.Proper(Format("1/" & i, "mmmm"))
                .Execute Replace:=2    '2 => wdReplaceAll
            Next
        End With
    End With
    Application.CutCopyMode = 0

Mais une erreur est survenue :

Instruction incorrecte à l'extérieur d'une procédure

sur la ligne :

Dc = wd.Documents.Add(ThisWorkbook.Path & "\Rapport.docx")

Remarque sur le 4ème code posté :

Bravo pour le format " : "@ c’était génial !

Mais les deux points alignés verticalement ne sont pas soulignés avec le texte de la colonne en gauche (DT, DO, Mois)(les mêmes caractéristique : Gras et souligné)

Merci d'avance.

 

[job75]

Re,

Pour la 1ère question vous avez oublié le Set devant Dc et de déclarer cette variable As Object.

Pour le soulignement des 2 points la question est nulle et non avenue.

A+

 

[job75]

Re,

J'ajoute que si vous avez d'autres problèmes de programmation sur Word ne comptez pas sur moi.

Je vous ai offert une "cerise sur le gâteau" c'est suffisant.

L'aide sur le web est excellente et ici nous sommes sur un forum Excel.

Bonne fin de soirée.

 

[job75]

Bonjour C60a, le forum,

Je précise quand même 2 choses :

- si les textes et/ou la mise en forme des signets doivent toujours être les mêmes, il est beaucoup plus simple de modifier manuellement une fois pour toutes le fichier source "Rapport.docx"

- quand on pilote Word depuis Excel il ne faut pas utiliser les mots clés de Word comme wdUnderlineSingle ou wdAlignParagraphCenter, il faut les remplacer par leurs valeurs numériques : vous remarquerez que dans ma macro j'utilise 2 à la place de wdReplaceAll.

Bonne journée.

 

[C60a]

Bonjour job75, le fil,

Je vous ai offert une "cerise sur le gâteau" c'est suffisant.

Merci infiniment pour cette "cerise"

Egalement pour tes consignes

@+

 

[C60a]

Bonjour job75, le fil,

Je vous ai offert une "cerise sur le gâteau" c'est suffisant.

Merci infiniment pour cette "cerise"

Egalement pour tes consignes

@+