Macro pour créer un fichier Word depuis Excel

[JF1000]

Bonjour à tous,

Je vais essayer de vous expliquer ce que j'aimerais faire mais ce dont malheureusement même après moult recherches je suis incapable.

J'ai mis en pièce jointe un fichier Excel d'exemple. Dans mon véritable fichier j'ai environ 3000 lignes et j'en rajoute une dizaine toutes les semaines.

Ce que j'aimerais c'est déclencher une macro en sélectionnant une ligne qui m'ouvre un fichier Word afin que je puisse noter des choses dedans.
Et que plus tard lorsque je déclenche de nouveau la macro, il me réouvre le fichier Word avec mes annotations.
En fait il faut que chaque ligne soit rataché à un document Word et que toute la procédure de création et de modification soit le plus automatique possible.

Exemple de mon fichier : En selectionnant la ligne numéro 6, il me crée un fichier Word appelé "RICARD Paul - 5".
Mais ensuite une fois ce fichier créer, il faut qu'il me l'ouvre et non pas qu'il en crée un deuxième...

En expliquant, je me rends compte que ça doit être difficilement faisable tout cela. Je ne sais pas si Excel peut savoir si il doit créer un nouveau fichier ou l'ouvrir simplement....

En tout cas, je vous serai vraiment très reconnaissant d'essayer de m'aider car cela me servirait énormément...

MERCI

 

[kjin]

Re : Macro pour créer un fichier Word depuis Excel

Bonsoir,
A tester et adapter en activant la ref Microsoft Word x.x Object Library dans le menu Outils de vbe
Ne pas oublier d'enregistrer le classeur avant
Les fichiers Doc sont enregistrés dans le répertoire du classeur, donc à adapter

Sub CreerOuvrirWord()
Dim Nom As String, NomDoc As String, Chemin As String, oWord As Word.Application, oDoc As Word.Document
Nom = Cells(ActiveCell.Row, 2) & " " & Cells(ActiveCell.Row, 3)
NomDoc = Nom & ".doc"
If Len(Nom) = 1 Then Exit Sub 'si la ligne ne contient ni nom ni prénom on quitte
Chemin = ActiveWorkbook.Path & "\" & NomDoc 'à adapter ici répertoire courant
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set oWord = CreateObject("Word.Application")
End If
On Error GoTo 0
If Dir(Chemin) <> "" Then
    Set oDoc = oWord.Documents.Open(Chemin)
Else
    Set oDoc = oWord.Documents.Add
    oDoc.SaveAs Chemin
End If
oWord.Visible = True
oWord.Activate

End Sub

A+
kjin

 

[JF1000]

Re : Macro pour créer un fichier Word depuis Excel

Alors là je suis impressionné !!!

MERCI Kjin !!!

J'ai pas trop le temps de tester en profondeur mais à priori ça a l'air de marcher et plutôt bien. Je regarde ça en détail, et je te poserai éventuellement quelques questions s'il y a des choses que je ne comprends pas.

En tout cas, un grand merci à toi.

 

[JF1000]

Re : Macro pour créer un fichier Word depuis Excel

Bonjour,

J'ai refais quelques essais ce matin et je confirme que cette macro est géniale, c'est exactement ce que je voulais mais je n'y serai jamais arrivé
Merci beaucoup.

J'ai 2 petites questions :

- Si je veux changer le chemin dans lequel il enregistre les fichiers, j'ai un petit soucis.

Avec Chemin = ActiveWorkbook.Path & "\" & NomDoc -> il m'enregistre dans le répertoire courant

Si je met Chemin = ActiveWorkbook.Path & "\Fiches\" & NomDoc -> il m'enregistre ça dans un répertoire Fiche

Mais j'aimerais qu'il m'enregistre ces fiches completement ailleurs, donc je pensais faire Chemin = ActiveWorkbook.Path & "c:\Disque\Fiches" & NomDoc
Mais ça ne fonctionne pas.....


Autre question, est-ce qu'il est possible lors de la création du fichier Word, de marquer automatiquement dans le fichier un titre reprenant les noms et prénoms de la personne.
Ex : FICHE de Paul RICARD et avec éventuellement une mise en forme...


Encore merci pour votre aide...

 

[kjin]

Re : Macro pour créer un fichier Word depuis Excel

Bonjour,

Mais j'aimerais qu'il m'enregistre ces fiches completement ailleurs, donc je pensais faire Chemin = ActiveWorkbook.Path & "c:\Disque\Fiches" & NomDoc
Mais ça ne fonctionne pas.....

Voir le code modifié.
Attention le chemin doit bien exister (je n'ai pas mis de contrôle)

Autre question, est-ce qu'il est possible lors de la création du fichier Word, de marquer automatiquement dans le fichier un titre reprenant les noms et prénoms de la personne.
Ex : FICHE de Paul RICARD et avec éventuellement une mise en forme...

J'ai ajouté un en-tête de page avec une mise en forme

Sub CreerOuvrirWord()
Dim NomDoc As String, Chemin As String, oWord As Word.Application, oDoc As Word.Document
Nom = Cells(ActiveCell.Row, 2) & " " & Cells(ActiveCell.Row, 3)
NomDoc = Nom & ".doc"
If Len(Nom) = 1 Then Exit Sub 'si la ligne ne contient ni nom ni prénom on quitte
Chemin = "[COLOR="Red"]C:\Disque\Fiches\[/COLOR]" & NomDoc 'à adapter
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set oWord = CreateObject("Word.Application")
End If
On Error GoTo 0
If Dir(Chemin) <> "" Then
    Set oDoc = oWord.Documents.Open(Chemin)
Else
    Set oDoc = oWord.Documents.Add
    With oDoc
        With .Sections(1).Headers(wdHeaderFooterPrimary).Range 'ajout d'un en-tête contenant le nom
            .Font.Bold = True 'en gras
            .Font.Italic = True 'en italique
            .Text = "Fiche de " & Nom
        End With
        .SaveAs Chemin
    End With
End If
oWord.Visible = True
oWord.Activate

End Sub

A+
kjin

 

[JF1000]

Re : Macro pour créer un fichier Word depuis Excel

Nickel, c'est génial..

Plus je le découvre et plus j'adore Excel...

Et si je veux rajouter une phrase mais pas dans l'en tête par contre ?

En tout cas merci pour ton aide kjin....

 

[kjin]

Re : Macro pour créer un fichier Word depuis Excel

Re,

'...
    With oDoc
        With .Sections(1).Headers(wdHeaderFooterPrimary).Range 'ajout d'un en-tête contenant le nom
            .Font.Bold = True 'en gras
            .Font.Italic = True 'en italique
            .Text = "Fiche de " & Nom
        End With
        [COLOR="Blue"].Range.Text = "La phrase que tu veux écrire"[/COLOR]
        .SaveAs Chemin
    End With
'...

A toi maintenant de travailler et de revenir si tu as qq soucis
A+
kjin

 

[JF1000]

Re : Macro pour créer un fichier Word depuis Excel

ah bah oui tout simple en fait

Merci beaucoup, j'ai déjà apporté pas mal de modifications en fonction de ce que je voulais. Mais tu m'a vraiment bien aidé.

Encore merci

 

[CG2000]

Re : Macro pour créer un fichier Word depuis Excel

Bonjour à tous, ainsi qu'au forum

Dîtes-moi en ce qui concerne :

Code:
'...
With oDoc
With .Sections(1).Headers(wdHeaderFooterPrimary).Range 'ajout d'un en-tête contenant le nom
.Font.Bold = True 'en gras
.Font.Italic = True 'en italique
.Text = "Fiche de " & Nom
End With
.Range.Text = "La phrase que tu veux écrire"
.SaveAs Chemin
End With
'...

à la place de "La phrase que tu veux écrire" est-il possible de transcrire le contenu de la cellule de la colonne D correspondant à "Fiche de " & Nom ?

Par exemple :

N° NOM Prénom blabla bla
1 DUPOND Marcel df kl kjl

Si mon choix est DUPOND, alors "La phrase que tu veux écrire" = df kl

Merci par avance de vôtre aide.

CG2000

 

[kjin]

Re : Macro pour créer un fichier Word depuis Excel

Bonjour,

Nom = Cells([B][COLOR="Blue"]ActiveCell.Row[/COLOR][/B], 2) & " " & Cells([B][COLOR="Blue"]ActiveCell.Row[/COLOR][/B], 3)

Puisque l'on connait la ligne où est la difficulté ?

'...
With oDoc
With .Sections(1).Headers(wdHeaderFooterPrimary).Range 'ajout d'un en-tête contenant le nom
.Font.Bold = True 'en gras
.Font.Italic = True 'en italique
.Text = "Fiche de " & Nom
End With
.Range.Text = Cells(ActiveCell.Row, [B][COLOR="Blue"]4[/COLOR][/B])
.SaveAs Chemin
End With
'...

Tu peux inscrire préalablement ces données dans un variable pour la rappeler ensuite comme je l'ai fait pour le nom
A+
kjin

 

[CG2000]

Re : Macro pour créer un fichier Word depuis Excel

Merci kjin,

Pour la péponse et la solution (rapide et parfaite).
Excel ne finira jamais de me surprendre. Que du plaisir de comprendre et de lire vos interventions, réponses, aides, explications, idées et votre patience à chacun de nous d'apprendre ou mieux comprendre excel.

Merci à toi et à vous tous qui faites vivre ce précieux forum.

GC2000