bonjour,

une nouvelle fois, j'ai besoin de vos connaissances

je cherche par vba à copier une plage nommee (Liste) d'une feuille excel et la coller dans word (nouveau document) avec Recueil pour nom

puis dans word effectuer la mise en page souhaitée

me faut-il faire 2 macros (une dans excel une dans word) ce que j'aimerai éviter si possible

dans l'attente de vos lumiere je vous remercie et vous souhaite un bon week end

Bonjour;

voilà un truc comme ça vous irait-il

il faut 3 fichiers doc à un endroit (bien reperer le chemin ) le programme ne fait pas

modifier la macro suivant votre chemin

Sub OuvrirWordAvecExcel1()
Dim AppWord As Object, lesdocuments As Object, ledoc As Object
Dim i As Byte
On Error GoTo piegeerreur
'Essaie de récupérer l'instance de Word
'active au cas où Word serait ouvert
'Si Word n'est pas ouvert, cela génère
'l'erreur numéro 429
'Dans ce cas, c'est le gestionnaire d'erreur "piegeerreur"
'qui prend le relais et qui ouvre Word
Set AppWord = GetObject(, "Word.Application")
AppWord.Visible = True
'ouvrir 3 documents Word
AppWord.documents.Open "C:\Users\........\Documents\Editions.doc"
AppWord.documents.Open "C:\Users\.........\Documents\Editions1.doc"
AppWord.documents.Open "C:\Users\..........\Documents\Editions2.doc"
'Parcourir la collection Documents et écrire un texte différent
'à la fin de chaque document
Set lesdocuments = AppWord.documents
For Each ledoc In lesdocuments

If ledoc.Name = "Editions.doc" Then
'Écrire "C'est le début et C'est fini" dans le document
ledoc.Select
AppWord.Selection.EndKey ' Unit:=wdStory
AppWord.Selection.InsertParagraph
AppWord.Selection.InsertAfter "C'est le début"
AppWord.Selection.EndKey
AppWord.Selection.InsertParagraph
AppWord.Selection.InsertAfter "Fin du texte"
ledoc.Save
ElseIf ledoc.Name = "Editions1.doc" Then
'Écrire "Fin du texte" à la fin du document
ledoc.Select
AppWord.Selection.EndKey 'Unit:=wdStory
AppWord.Selection.InsertParagraph
AppWord.Selection.InsertAfter "Fin du texte"
ledoc.Save
ElseIf ledoc.Name = "Editions2.doc" Then
'Écrire "Bonjour" à la fin du document
ledoc.Select
AppWord.Selection.EndKey 'Unit:=wdStory, Extend:=wdMove
AppWord.Selection.InsertParagraph
AppWord.Selection.InsertAfter "Bonjour"
ledoc.Save
End If
Next
'Fermer les documents
For Each ledoc In lesdocuments
ledoc.Close
Next
'Fermer Word
AppWord.Quit
'Sortie de routine, pour éviter le gestionnaire d'erreurs
Exit Sub
'Gestionnaire d'erreurs
piegeerreur:
Select Case Err.Number
Case 429
'Word n'est pas ouvert
'Ouverture de Word et reprise
'du programme à la ligne suivant
'celle où s'est produit l'erreur
Set AppWord = CreateObject("Word.Application")
Resume Next
Case 5153
'Le fichier "DOC" existe déjà.
'Fin du programme.
'Au lieu de terminer le programme, on pourrait
'mettre à laplace la possibilité de changer le
'nom du fichier, mais là, je n'ai pas le temps
MsgBox "Le fichier existe déjà. Fin du programme et retour à Word "
Case 4120
MsgBox "Erreur mauvais paramétres"
Case 5273
MsgBox "Erreur Nom ou chemin du fichier non valide"

Case Else

MsgBox "Erreur imprévue. Fin du programme et retour à Word" & Err.Number
End
End Select
End Sub

bonjour Gilbert,

je te remercie une nouvelle fois et je te tiendrai au courant, mais pourquoi : il faut 3 fichiers doc à un endroit

c'est juste une demo

et dans cette demo il y a 3 fichiers différents dans lesquels on ecrit un texte different aussi

tout simplement

mais on peut faire que pour un seul fichier bien entendu il suffit de modifier ou de placer des remarques

OK

Merci infiniement Gilbert et bon week-end

re,

bonjour à vous,

merci gilbert, mais je bloque ici pour l'instant :

'Ce programme permet de copier des données d'Excel,
'd'ouvrir un document Word et d'y coller les données
Const WordDocName = "Recueil.doc"

Sub ExportExcelVersWord()
Dim MonAppliWord As Word.Application
Dim MonDocWord As Word.Document
'Désactivation de la mise à jour de l'écran
Application.ScreenUpdating = False
'Création d'un nouvel objet Word
Set MonAppliWord = New Word.Application
'Permet d'afficher l'application WOrd
MonAppliWord.Visible = True
'Crée un nouveau document dans Word
Set MonDocWord = MonAppliWord.Documents.Add
'J'affiche la feuille mp3
Sheets("mp3").Visible = True
Sheets("mp3").Activate
'Sélectionne la plage de cellule utilisée dans la feuille active

***ICI***

'Copie la sélection de cellules
Selection.Copy
'Colle les données copiées dans Word
MonAppliWord.Selection.Paste
'Ajuste le tableau copié à la largeur de la page
MonDocWord.Tables(1).AutoFitBehavior wdAutoFitWindow
'Désactive le mode Copier/Coller
Application.CutCopyMode = False
'Pour changer de dossier, mettre avant la ligne :
ChangeFileOpenDirectory "C:\Cantiques\"
'Fermer le document Word en enregistrant les modifications
'''DocWord.Close True
'quitter l'application Word
AppWord.Quit
'Réactivation de la mise à jour de l'écran
Application.ScreenUpdating = True
End Sub

ICI : je desire selectionner les colonnes A et B (A qui contient cette formule : =SI(B3="";"";A2+1) - et la colonne B qui contient un nom - la selection devant se faire par rapport au contenu de la colonne B et selectionner A et B

Je vous remercie

a la place de Ici il faut mettre le code conditionnel

pour selectionner la plage qui vous interesse

bonsoir gilbert,

heureux de te voir

c'est justement la que je bloque

he oui je travaille le reste du temps :-))

il faudrait juste mettre un petit exemple de ce que vous desirez

parce que avec cette explication je ne comprends pas grand chose

"ICI : je desire selectionner les colonnes A et B (A qui contient cette formule : =SI(B3="";"";A2+1) - et la colonne B qui contient un nom - la selection devant se faire par rapport au contenu de la colonne B et selectionner A et B"

selectionner les colonnes A et B si B = ????? sinon !!!!!!!

http://www.cijoint.fr/cjlink.php?file=cj201110/cij6iTPoDD.xls

bien sur cette zone va augmenter lors des rajouts de titres

pour la numerotation je viens de trouver ca :

Private Sub Num_Change()
Range("a2000").End(xlUp).Row 1
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C+1)"
End Sub

un truc du genre ?

cliquez ici

merci beaucoup gilbert et bonne soiree

une erreur excusez moi

cliquez là

effectivement, merci gilbert d'avoir corrigé c'est ok maintenant.

en te souhaitant une bonne journee

gilbert, ton code me numerote a partir de A1 comment le modifier pour commencer a A2

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
nl = Range("b65536").End(xlUp).Row
For i = 1 To nl
Cells(i, 1).NumberFormat = "0000"
Cells(i, 1).Value = i
Next
End Sub

en te remerciant

For i = 1 To nl
Cells(i, 1).NumberFormat = "0000"
Cells(i, 1).Value = i
Next

ce qui veut dire

faire une boucle qui va de un à nl (nl etant le nombre de lignes)

cells(i,1) signifie cellule (ligne i , colonne 1) donc ( A1) pour la première boucle

alors pour commencer en A2 il faut que la boucle démarre en 2 donc

For i = 2 to nl

voilà ce n'est pas sorcier

je te remercie gilbert c'est ok

bonne soiree