Copier coller tableaux Excel vers WORD
Bonjour à tou(te)s !
Voilà, j'ai un problème depuis qq jours et je n'arrive pas à le régler... Pour tout vous dire, j'ai vraiment beaucoup de mal à trouver des explications pour essayer de résoudre celui-ci.
J'ai un classeur EXCEL. Au sein de celui-ci j'ai un certain nombres de feuilles. J'ai notamment une feuille qui se nomme "TABLEAUX" avec dedans un nombre de tableau variable produit de manière automatique grâce à de précédents programmes. Un détail important est que traitant divers fichiers, le nombre de tableaux peut évoluer dans cette feuille.
Ils sont tous organisés de cette manière : (seul le nombre de modalité peut évoluer)
NOM EFFECTIF FREQUENCE
Mod1
Mod2
(vide)
TOTAL
Je cherche à les copier coller vers un fichier WORD de manière à les mettre les uns, en dessous des autres, et ce, de manière automatique grâce à VBA.
Je ne sais pas si quelqu'un pourra me venir en aide, mais si oui, ça serait génial !
En vous remerciant tou(te)s du temps que vous m'accorderez.
Cdt ☺
Je tiens à rajouter une précision concernant la mise en forme des tableaux sur EXCEL. A savoir que chacun de ses tableaux sont séparé par une colonne vierge. J'ai donc un tableau à la colonne 1, 5, 9, 13, etc...
Merci par avance !
Bonjour,
Ci-après un exemple de code pour, à partir d'excel :
* créer un document word,
* le nommer et l'enregistrer en : Fiche_dateheure.docx
* et coller 2 zones du fichiers excel (ici dans l'exemple A1:A9 puis J7:K8 de l'onglet Feuil1)
Public Const wdLineBreak = 6
Sub Export_word()
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
With WordApp.Selection
Sheets("Feuil1").Range("A1:E9").Copy
.Paste
.InsertBreak Type:=wdLineBreak
Sheets("Feuil1").Range("J7:K8").Copy
.Paste
.InsertBreak Type:=wdLineBreak
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Document Word Ok", , "Lilouxxx"
End Sub
Il suffit d'adapter ce code à ton fichier
Bonne journée
Pierre
Bonjour pierrep56,
Merci déjà pour votre solution !
Cependant, elle ne correspond pas tout à fait avec ce que je souhaite mettre en place.
En effet, j'ai un nombre de tableaux variables sur ma feuille. Seul le nombre de colonnes d'un tableau reste fixe (à savoir 3). Mais mon nombre de modalités peut varier tout comme le nombre de tableaux sur ma feuille.
Voyez-vous une solution à cela ?
Merci d'avance et encore merci pour ta solution !
Bah, comme je disais, il suffit d'adapter.
Avec une simple boucle, c'est pas dur quand même!
Public Const wdLineBreak = 6
Sub Export_word()
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer, cl As Integer, lg As Integer
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
With WordApp.Selection
cl = Sheets("TABLEAUX").Range("IV1").End(xlToLeft).Column - 2
For i = 1 To cl Step 4
lg = Sheets("TABLEAUX").Range("A" & Rows.Count).End(xlUp).Row
Sheets("TABLEAUX").Range(Cells(1, i), Cells(lg, i + 3)).Copy
.Paste
.InsertBreak Type:=wdLineBreak
Next i
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Document Word Ok", , "Lilouxxx"
End Sub
Bonjour pierrep56,
Désolé de mon ignorance sincèrement mais ce sont mes premiers pas sur VBA et presque les premiers en matière de programmation d'où mes questions qui peuvent sembler un peu "innocente" pour certains d'entre vous, je m'en excuse !
Pour revenir à votre solution, elle fonctionne et je t'en remercie !
Seulement, il y a un petit "hic". En effet, lorsque je consulte le document WORD fraîchement créé, je remarque que maximum 9 lignes de mes tableaux ont été copiées-collées. Voyez-vous d'où cela peut provenir ?
Merci encore !
Ben oui, je suis bête, il fallait écrire
lg = Sheets("TABLEAUX").Cells(1, i).End(xlDown).Row
sorry
Pierre
Ca fonctionne à merveille Pierre ! Mille merci pour ton aide et ton temps ! ☺☺☺☺
Bonjour,
En utilisant le même code, j'arrive à générer un nouveau document Word, mais il copie mon presse papier et non le tableau de la feuille excel. Alors que j'ai bien référencé le nom de la feuille de calcul.
Quelqu'un aurait il une idée sur comment palier à ce problème?
merci d'avance.
Bonjour msdiallobe, le forum,
à tout hasard, par rapport à With WordApp.Selection
as-tu bien mis un point devant Paste
et InsertBreak
?
.Paste
.InsertBreak Type:=wdLineBreak
si c'est ça : ok ; sinon : j'ai pas d'autre idée ; continue de surveiller les prochaines réponses.
dhany
Bonjour à tous, salut Dhany
Autre point à vérifier, est-ce que ta ligne .copy
est bien fonctionnelle?
Tu peux nous montrer ton code?
Voici mon code. J'ai bien essayé d’espionner les variables pour résoudre le problème, mais rien ne fonctionne.
Public Const wdLineBreak = 6
Sub Export_word()
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer, cl As Integer, lg As Integer, t As Integer
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
With WordApp.Selection
.PageSetup.Orientation = wdOrientLandscape
cl = Sheets("Evaluation Des Risques").Range("IV1").End(xlToLeft).Column - 2
For i = 1 To cl Step 4
lg = Sheets("Evaluation Des Risques").Range(1, i).End(xlDown)
Sheets("Evaluation Des Risques").Range(Cells(1, i), Cells(lg, i + 3)).Copy
.Paste
.InsertBreak Type:=wdLineBreak
Next i
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
'MsgBox "Document Word Ok", , "Lilouxxx"
End Sub
Oulà, malheureux!! il ne faut pas confondre l'objet WordDoc et WordApp.Selection!
L'orientation paysage se fait sur le WordDoc
, avant d'écrire sur la WordApp.selection
!
Set WordDoc = WordApp.Documents.Add
WordDoc.PageSetup.Orientation = wdOrientLandscape
With WordApp.Selection
cl = ... etc ...
J'utilise votre code en changeant uniquement le nom de la feuille de calcul qui est ici "Evaluation Des Risques".
C'est qui m'intrigue, c'est que des fois ça marche, mais une fois que j'effectue un copier-coller avec la sourie et que je génère un nouveau document j’obtiens dans le document mon presse papier et non le tableau.
Public Const wdLineBreak = 6
Sub Export_word()
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer, cl As Integer, lg As Integer
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
With WordApp.Selection
cl = Sheets("Evaluation Des Risques").Range("IV1").End(xlToLeft).Column - 2
For i = 1 To cl Step 4
lg = Sheets("Evaluation Des Risques").Cells(1, i).End(xlDown).Row
Sheets("Evaluation Des Risques").Range(Cells(1, i), Cells(lg, i + 3)).Copy
.Paste
.InsertBreak Type:=wdLineBreak
Next i
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
'MsgBox "Document Word Ok", , "Lilouxxx"
End Sub
Sur mon PC, le code suivant donne un résultat correct à 100%
(si la feuille excel en question contient au moins 3 colonnes depuis A et commençant à la ligne 1)
Public Const wdOrientLandscape = 1
Public Const wdLineBreak = 6
Sub Export_word()
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer, cl As Integer, lg As Integer
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
WordDoc.PageSetup.Orientation = wdOrientLandscape
With WordApp.Selection
cl = Sheets("Evaluation Des Risques").Range("IV1").End(xlToLeft).Column - 2
For i = 1 To cl Step 4
lg = Sheets("Evaluation Des Risques").Cells(1, i).End(xlDown).Row
Sheets("Evaluation Des Risques").Range(Cells(1, i), Cells(lg, i + 3)).Copy
.Paste
.InsertBreak Type:=wdLineBreak
Next i
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub
msdiallobe a écrit :J'utilise votre code en changeant uniquement le nom de la feuille de calcul qui est ici "Evaluation Des Risques".
Ce qui m'intrigue, c'est que des fois ça marche, mais une fois que j'effectue un copier-coller avec la souris et
que je génère un nouveau document, j’obtiens dans le document mon presse-papiers et non le tableau.
si tu obtiens des résultats différents de ceux de pierrep56 en utilisant le même code VBA, alors c'est peut-être à cause d'un paramétrage différent d'Excel ou de Word ; je pense plutôt à ces paramètres de Word :
(c'est juste une piste, alors ça donnera peut-être rien de plus)
que ça ait marché ou non, lis quand même le message précédent de pierrep56 :
https://forum.excel-pratique.com/viewtopic.php?p=662448#p662448
dhany
Je crois comprendre le problème, le code fonctionne si je suis dans la feuille de calcul ou se trouve le tableau, si je me mets dans une autre feuille de calcul du même document, le code ne fonctionne plus. Ici je travaille avec un tableau de bord donc mes boutons se trouvent dans une autre feuille c'est pour cela que ça ne fonctionne pas. Des lors il faut que je puisse d'abord me positionner dans la feuille avant de commencer la boucle par exemple avec
Workbooks("A_L_R").Sheets("Evaluation Des Risques").Activate
Si quelqu'un a une autre idée je suis preneur.
Un grand merci à vous pour votre réactivité et votre aide.
j'ai modifié ainsi le code de pierrep56 (rappel : il marchait très bien tel quel sur son PC mais pas sur le tien, pour une raison inconnue) :
Option Explicit
Public Const wdOrientLandscape = 1
Public Const wdLineBreak = 6
Sub Export_word()
' cette macro ne marchera que si tu la lance à partir de la feuille "Evaluation Des Risques",
' sinon rien : on sort de la sub ; autre possibilité : mettre à la place cette instruction :
' Worksheets("Evaluation Des Risques").Select
If ActiveSheet.Name <> "Evaluation Des Risques" Then Exit Sub
Dim NDF As String
Dim WordApp As Object, WordDoc As Object
Dim i As Integer, cl As Integer, lg As Integer
NDF = ActiveWorkbook.Path & "\" & "Fiche_" & Format(Now(), "yyyymmdd_hhmm")
On Error Resume Next
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
WordDoc.PageSetup.Orientation = wdOrientLandscape
With WordApp.Selection
cl = Range("IV1").End(xlToLeft).Column - 2
For i = 1 To cl Step 4
lg = Cells(1, i).End(xlDown).Row
Range(Cells(1, i), Cells(lg, i + 3)).Copy
.Paste
.InsertBreak Type:=wdLineBreak
Next i
End With
Application.CutCopyMode = False
WordDoc.SaveAs NDF
Set WordDoc = Nothing
Set WordApp = Nothing
End Sub
à essayer à tout hasard : p't'être que ça marchera pas non plus sur ton PC ? (lis bien attentivement le commentaire au début de la sub !)
note bien qu'avec la 1ère instruction de la sub (au choix le test ou la sélection d'office de la feuille), on est forcément sur la bonne feuille "Evaluation Des Risques" dès le départ ; c'est pourquoi on peut simplifier les instructions du bloc With .. End With : ça devient inutile de préciser 3× la feuille "Evaluation Des Risques" puisque sans indication explicite de feuille, ça utilise par défaut la feuille active, qui est justement la feuille "Evaluation Des Risques".
dhany