XL 2019 Relations entre excellent et Word

dubarre

XLDnaute Occasionnel
Bonjour à tous,

Je viens vous voir car j'ai une petite question je suis en train de créer un petit programme sur Excel qui doit avoir une relation avec Word mon problème est que je ne connais pas et je n'arrive pas à trouver sur Internet si il est possible de créer une commandbutton qui pourrait automatiser soit réaliser un courrier publipostage soit un courrier individuel tout simplement en cliquant sur le bouton que ça ouvre un courrier type sur Word et que ça remplisse le champ nom prénom adresse en fonction du choix de la personne que j'aurais fait sur Excel je sais que c'est peut-être compliqué ce que je demande mais je ne sais pas si ça existe merci de vos réponses
 
Solution
Bonjour,

Dans l'UserForm cliquez sur le bouton "Envoyé un courrier" pour exécuter cette macro :
VB:
Private Sub CommandButton6_Click() 'Envoyé un courrier
Dim Wapp As Object, x$
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open ThisWorkbook.Path & "\Doc_Word1.docx" 'nom à adapter
With Wapp.ActiveDocument
    .Bookmarks("Date").Range = Date
    x = Replace(Replace(Replace(CbxCivilite, "M.", "Monsieur"), "Mme", "Madame"), "Mlle", "Mademoiselle")
    .Bookmarks("Civilite1").Range = x
    .Bookmarks("Civilite2").Range = x
    .Bookmarks("Civilite3").Range = x
    .Bookmarks("Nom").Range = TextBox24 & " " & TextBox2...

job75

XLDnaute Barbatruc
Bonjour dubarre,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Et dans le fichier Excel exécutez cette macro en cliquant sur le bouton :
VB:
Sub TransfertSurWord()
Dim Wapp As Object
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open ThisWorkbook.Path & "\Doc Word.docx" 'nom à adapter
With Wapp.ActiveDocument
    .Bookmarks("Date").Range = [C3]
    .Bookmarks("Civilite1").Range = [C5]
    .Bookmarks("Civilite2").Range = [C5]
    .Bookmarks("Civilite3").Range = [C5]
    .Bookmarks("Nom").Range = [C7]
    .Bookmarks("Adresse").Range = [C9]
End With
AppActivate "Word" 'facultatif
End Sub
A+
 

Pièces jointes

  • Source(1).xlsm
    17.2 KB · Affichages: 34
  • Doc Word.docx
    12.4 KB · Affichages: 32

dubarre

XLDnaute Occasionnel
Cher Monsieur job 75 veuillez m'excuser si je ne vous ai point répondu concernant ce que vous m'avez transmis je suis parti sur autre chose et j'ai mis d'autres sujets avec d'autres questions dans ce forum sans vouloir offusquer j'ai très bien compris ce que vous m'avez transmis mais je ne vais pas encore tout de suite l'utiliser car j'ai eu quelques petits soucis comme vous avez pu voir sur sujet que j'avais besoin de régler avant de faire cela
 

dubarre

XLDnaute Occasionnel
Bonjour

Il est vrai que j'ai posé cette question je n'avais pas fait attention veuillez m'excuser pour l'autre question réaliser dans l"autre discussion

Je vous mets le classeur car j'ai essayé de reprendre ce que vous avez proposé comme code mais il y a peut-être quelque chose que je ne comprends pas dans le classeur pour faire le coller dans word

Un bouton dans la feuil2 ouvre un formulaire et j'ai mis en essayant d'adapter votre code dans le bouton qui s'appelle "envoyer un courrier" cela rentre bien les données dans les cellules et après l'ouverture de Word rien ne se passe je n'arrive pas à comprendre comment cela se colle dans Word pouvez-vous me dire d'où vient mon erreur s'il vous plaît

Merci de votre aide.
 

Pièces jointes

  • Doc_Word1.docx
    12.5 KB · Affichages: 4
  • BDDWord.xlsm
    46.5 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour,

Dans l'UserForm cliquez sur le bouton "Envoyé un courrier" pour exécuter cette macro :
VB:
Private Sub CommandButton6_Click() 'Envoyé un courrier
Dim Wapp As Object, x$
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open ThisWorkbook.Path & "\Doc_Word1.docx" 'nom à adapter
With Wapp.ActiveDocument
    .Bookmarks("Date").Range = Date
    x = Replace(Replace(Replace(CbxCivilite, "M.", "Monsieur"), "Mme", "Madame"), "Mlle", "Mademoiselle")
    .Bookmarks("Civilite1").Range = x
    .Bookmarks("Civilite2").Range = x
    .Bookmarks("Civilite3").Range = x
    .Bookmarks("Nom").Range = TextBox24 & " " & TextBox2
    .Bookmarks("Adresse").Range = Mid(IIf(TextBox3 = "", "", vbLf & TextBox3) & IIf(TextBox4 = "", "", vbLf & TextBox4) _
        & IIf(TextBox5 = "", "", vbLf & TextBox5) & IIf(TextBox6 = "", "", vbLf & TextBox6), 2) & vbLf & TextBox7 & " " & TextBox25
End With
AppActivate "Word" 'facultatif
End Sub
A+
 

Pièces jointes

  • BDDWord(1).xlsm
    53.3 KB · Affichages: 26
  • Doc_Word1.docx
    12.5 KB · Affichages: 28

Discussions similaires

Statistiques des forums

Discussions
312 046
Messages
2 084 855
Membres
102 688
dernier inscrit
Biquet78