Import d'information d'Excel vers fichier Word

[Delux]

Bonjour a tous,

(desole pour les accents, je suis sur un clavier QWERTY)

J'ai deux documents 1 word (PESG MOM Test.docm [je ne peux pas mettre le .docm donc je mets le .docx]) et 1 excel (Excel for MOM.xlsx).
Mon but, extraire les informations de mon fichier EXCEL vers mon fichier WORD grace a une macro dans ce dernier (word).

J'ai bien reussi a faire une macro pour extraire les informations mais je souhaterais que la macro selectionne automatiquement les cellules pleines de mon fichier excel du genre :

Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select

Cependant, je n'arrive pas a implementer cela dans ma macro.

De plus, lorsque les informations se collent dans le tableau du fichier WORD, les cellules contenant les titres des colonnes changent de taille alors que je l'ai aies bloquees grace a la macro et par le menu de tableau.

Autre contrainte, il faut que je sois dans la premiere cellule de mon tableau sur mon fichier WORD pour que les informations se remplissent au bonne endroit :/
Si quelqu'un a une solution pour que cela se copie automatiquement en dessous des cellules de titre, je suis preneur

Voici ma macro:

 Sub Import()

Dim MyXL As New Excel.Application

Set MyXL = New Excel.Application
Set MyXL = GetObject(, "Excel.Application")
MyXL.Workbooks.Open "C:\Documents and Settings\clt\Desktop\PESG\Test\Excel for MOM.xlsx"

'Selection des donnees sur le fichier excel A2:E(derniere cellule remplie)
MyXL.Range("A2:E40").Select 'a modifier par la derniere ligne pleine de mon tableau excel

'Copy
MyXL.Selection.Copy

'Activation du fichier WORD PESG MOM test
Windows("PESG MOM test.docx").Activate

'Selection de la premiere ligne en dessous du titre
 Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=5, Extend:=wdExtend

Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitFixed)

'Coller par dessus les anciennes informations
Selection.PasteAndFormat Type:=wdTableOverwriteCells

'Ajustement a la mise en page
Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)


MyXL.Quit
Set MyXL = Nothing
End Sub

En vous remerciant par avance

Codialement,

Delux

 

[Delux]

Re : Import d'information d'Excel vers fichier Word

Re,

Si non je pensais a ce genre de code aussi :

Sub Import()

Dim MyXL As New Excel.Application
Dim myCible As Range
Dim Lg As Integer
Dim Cell As Range

Set MyXL = New Excel.Application
Set MyXL = GetObject(, "Excel.Application")
Set mySource = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("F2:F200")
Set myCible = Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("A2:E76")



Lg = 2

MyXL.Workbooks.Open "C:\Documents and Settings\clt\Desktop\PESG\Test\Excel for MOM.xlsx"

For Each Cell In mySource
    If Cell = 1 Then

        Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("A" & Lg) = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("A" & Cell.Rows)
        Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("B" & Lg) = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("B" & Cell.Rows)
        Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("C" & Lg) = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("C" & Cell.Rows)
        Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("D" & Lg) = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("D" & Cell.Rows)
        Workbooks("PESG MOM test2").Worksheets("Sheet1").Range("E" & Lg) = Workbooks("Excel for MOM").Worksheets("Sheet1").Range("E" & Cell.Rows)
        Lg = Lg + 1
        
     End If
    Next

MyXL.Quit

Set MyXL = Nothing

End Sub

Mais il ne me reconnait pas :

myCible.ClearContents
If Cell.Value = 1 Then

Si quelqu'un a une solution je suis preneur

Merci

 

[Delux]

Re : Import d'information d'Excel vers fichier Word

Si non j'ai essaye avec cette solution, mais j'obtiens une erreur:

Can't Assign to read-only property

pour la ligne:

wordDoc.Tables(3).Range("A" & Lg) = Range("A" & Cell.Rows)

Sub EnvoyerTableauxExcelVersWord()
'necessite d'activer la reference Microsoft Word xx.x Object Library

Dim AppWord As Word.Application
Dim wordDoc As Word.Document
Dim myCible As Range
Dim mySource As Range
Dim Lg As Integer
Dim Cell As Range

Set mySource = Sheets("Sheet1").Range("F2:F200")


Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
Set wordDoc = AppWord.Documents.Open("C:\Documents and Settings\clt\Desktop\PESG\Test\PESG MOM test.docx") 'ouverture du doc WORD

Lg = 2

For Each Cell In mySource
    If Cell = 1 Then

        wordDoc.Tables(3).Range("A" & Lg) = Range("A" & Cell.Rows)
        wordDoc.Tables(3).Range("B" & Lg) = Range("B" & Cell.Rows)
        wordDoc.Tables(3).Range("C" & Lg) = Range("C" & Cell.Rows)
        wordDoc.Tables(3).Range("D" & Lg) = Range("D" & Cell.Rows)
        wordDoc.Tables(3).Range("E" & Lg) = Range("E" & Cell.Rows)
        Lg = Lg + 1
        
     End If
    Next

wordDoc.Close True 'ferme le document Word en enregistrant les modifications
AppWord.Quit 'ferme l'application Word


Application.CutCopyMode = False
End Sub

On ne peut pas dire que je n'essaye pas, mais pour le coup je n'y arrive vraiment pas

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Bonjour Delux,

Sur ce forum on fait des macros pour Excel, mais pour une fois...

1) Dans le fichier Word sélectionner tout le tableau et insérer le signet Tableau.

2) Y introduire cette macro et la lancer avec le fichier Excel ouvert :

Sub CopieTableauExcel()
'IMPORTANT : cocher la référence "Microsoft Excel xx.x Object Library"
Dim MyXL As Excel.Application, plage As Excel.Range, h1&, h2&, i&
On Error Resume Next
Set MyXL = GetObject(, "Excel.Application")
If Err Then MsgBox "Excel absent...": Exit Sub
On Error GoTo 0
Set plage = MyXL.activeworkbook.sheets("Sheet1").[A1].currentregion
h1 = plage.Rows.Count
If h1 < 2 Then MsgBox "Pas de tableau...": Exit Sub
Application.ScreenUpdating = False
With ActiveDocument.Bookmarks("Tableau").Range
  h2 = .Rows.Count
  If h1 > h2 Then
    .Rows(2).Select
    Selection.InsertRowsAbove h1 - h2
  Else
    For i = 1 To h2 - h1
      .Rows(2).Delete
    Next
  End If
  plage.Copy
  .Paste
  MyXL.CutCopyMode = False
End With
Set MyXL = Nothing
Set plage = Nothing
End Sub

Il y a des mises en forme à faire, je ne m'en suis pas occupé.

Fichiers Word et Excel joints.

Edit : pardon, je n'avais pas mis la macro dans un Module du projet...

A+

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Bonjour Delux, le forum,

Pour la mise en forme il suffisait de mettre les retraits à zéro.

Fichier (2).

A+

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Re,

Fichiers (3) avec des retraits de 2 mmm.

A+

 

[Delux]

Re : Import d'information d'Excel vers fichier Word

Bonjour Job75,

Merci pour votre macro elle fonctionne a merveille (comme toujours)
Pour le poste, je pensais passer par excel, et c'est pour cela que j'ai fait un post ici mais par le fichier Word cela me va parfaitement.

Je viens juste de voir votre modification pour la mise en page. J'avais trouve une solution qui fonctionne mais je vais quand meme jeter un coup d'oeil a la votre

With ActiveDocument.Bookmarks("Tableau").Range.ParagraphFormat
  .LeftIndent = CentimetersToPoints(0.01)
  .SpaceBeforeAuto = False
  .SpaceAfterAuto = False
  End With

Si non, la reactivite est bonne.

Petite question, si j'ouvre plusieurs fichier excel en meme temps, est-ce que cela risque de tout copier?

Autre question, si je voulais organiser automatiquement par la premiere colonne (item) puis par la seconde (owner), est-ce possible? Ou est-ce plus simple de le faire dans le fichier excel avant l'import?

Merci pour votre aide

Cordialement

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Re,

1) Voyez la macro : dans Excel c'est activeworkbook.sheets("Sheet1") qui est copiée.

2) La mise en forme séparément de chaque colonne du tableau Word ne paraît pas possible.

Mettez en forme le tableau Excel avant de le copier.

A+

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Re,

On peut quand même mettre en forme les colonnes du tableau Word de cette manière :

Dim cc As Byte, cel As Object
'-----
  i = 0: cc = .Columns.Count
  For Each cel In .Cells
    i = i + 1
    If i Mod cc = 1 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    If i Mod cc = 2 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
  Next

Fichiers (4).

A+

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Bonjour Delux, le forum,

Jusqu'à maintenant les couleurs de fond des cellules Excel n'étaient pas copiées.

Pour y parvenir compléter le code dans Word :

Dim cc As Byte, cel As Object, lig&, col As Byte
'-----
  i = 0: cc = .Columns.Count
  For Each cel In .Cells
    lig = Int(i / cc) + 1
    col = (i Mod cc) + 1
    cel.Shading.BackgroundPatternColor = plage(lig, col).Interior.Color
    If col = 1 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    If col = 2 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    i = i + 1
  Next

Fichiers (5), testés seulement sur Microsoft Office 2003.

A+

 

[Delux]

Re : Import d'information d'Excel vers fichier Word

Bonjour Job75,

Encore une fois merci pour votre implication

Tout fonctionne a merveille

Vous etes vraiment tres fort

Maintenant je vais plancher sur le fichier excel.
En effet, le tableau excel qui va etre importe dans WORD sera alimante par plusieurs classeurs excel (qui ont exactement la meme template, mais avec un nom legerement different).

Par exemple:
- Fichier source = Excel for PESG coordination meeting_CLT.xls
Excel for PESG coordination meeting_FAB.xls ...etc

- Fichier destination = Excel for PESG coordination meeting

- Fichier excel avec Macro = Import.xls (le mieux serait de mettre la macro dans le fichier destination pour eviter d'avoir un classeur ouvert juste pour une macro)

J'ai utilise la macro de MichelXD (datant de 2006) qui est geniale, mais qui est restrictive :
- on ne peut importer qu'un seul fichier source
- si le tableau existe deja et si l'on efface les donnees precedantes avant l'importation, les informations copier sont collees bien plus bas (alors que si l'on supprime les lignes que l'on veut effacer, cela fonctionne)

Voici la macro en question

Option Explicit

'"Excel for PESG coordination meeting_CLT.xls"
'toutes les données de la Feuil1 sont récuperees dans la requete
'----------------------------------------------------------------

'Excel for PESG coordination meeting.xls .
'les données recuperees sont ajoutées a la suite des enregistrements existants "
'Le classeur contenant la macro et les 2 classeurs fermés sont dans le meme repertoire

Sub tranfertEntreClasseursFermes()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
'------------------------------------------------------------------
' "Excel for PESG coordination meeting_CLT.xls" est le classeur source
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\Excel for PESG coordination meeting_CLT.xls;" & _
"Extended Properties=""Excel 8.0;HDR=NO;"" "
'les donnees sources sont dans la Feuil1 du classeur "Excel for PESG coordination meeting_CLT.xls"

oProdRS.Open "SELECT * FROM [Sheet1$]", Cn, adOpenStatic

'------------------------------------------------------------------
' "Excel for PESG coordination meeting.xls" est le classeur destination
Set oConn = New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\Excel for PESG coordination meeting.xls;" & _
"Extended Properties=""Excel 8.0;HDR=NO;"""

'les donnees sont à placer dans la Feuil1 du classeur "Excel for PESG coordination meeting.xls"
Set oRS = New ADODB.Recordset
oRS.Open "Select * from [Sheet1$]", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------------------
'transfert des données
Do While Not (oProdRS.EOF)
    oRS.addNew
        For j = 0 To oRS.Fields.Count - 1
        oRS.Fields(j) = oProdRS.Fields(j).Value
        Next j
    oRS.Update
    oProdRS.moveNext
Loop

oProdRS.Close
Cn.Close
oRS.Close
oConn.Close
End Sub

C'est impressionnant ce que l'on peut realiser avec excel/VBA

Mon but, faire en sorte que la macro importe plusieurs fichiers excel source, en les copiant les uns apres les autres dans le fichier destination.

Si je ne parviens pas a adapter cette macro je reviendrais certainement vers vous pour obtenir vos lumieres en la matiere

PS: j'ai attache le fichier import.xls si vous voulez le consulter

En tous cas, encore un grand MERCI

Cordialement,

Delux

 

[job75]

Re : Import d'information d'Excel vers fichier Word

Bonjour Delux, le forum,

Une solution avec la macro dans le classeur Excel.

Ici le fichier Word peut être ouvert ou fermé :

Private Sub CommandButton1_Click()
'IMPORTANT : cocher la référence "Microsoft Word xx.x Object Library"
Dim chemin$, fichier$, MyWord As Word.Application, MyDoc As Word.Document
Dim plage As Range, h1&, h2&, i&, cc As Byte, cel As Object, lig&, col As Byte
'---préparation de Word---
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "Doc Word.doc*") 'nom à adapter
If fichier = "" Then MsgBox "'Doc Word' introuvable...": Exit Sub
On Error Resume Next
Set MyWord = GetObject(, "Word.Application")
If Err Then Set MyWord = CreateObject("Word.Application"): Err = 0
Set MyDoc = MyWord.Documents(fichier)
If Err Then Set MyDoc = MyWord.Documents.Open(chemin & fichier)
On Error GoTo 0
'---dimensionnement du tableau Word et copie---
Set plage = [A2].CurrentRegion 'à adapter éventuellement
If plage.Rows.Count = 1 Then Set plage = plage.Resize(2) 'au moins 2 lignes
h1 = plage.Rows.Count
With MyDoc.Bookmarks("Tableau").Range
  h2 = .Rows.Count
  If h1 > h2 Then
    For i = 1 To h1 - h2
      .Rows.Add .Rows(2)
    Next
  Else
    For i = 1 To h2 - h1
      .Rows(2).Delete
    Next
  End If
  plage.Copy
  .Paste
  Application.CutCopyMode = False
  '---mises en forme---
  .ParagraphFormat.LeftIndent = MyWord.CentimetersToPoints(0.2)
  .ParagraphFormat.RightIndent = MyWord.CentimetersToPoints(0.2)
  i = 0: cc = .Columns.Count
  For Each cel In .Cells
    lig = Int(i / cc) + 1
    col = (i Mod cc) + 1
    cel.Shading.BackgroundPatternColor = plage(lig, col).Interior.Color
    If col = 1 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    If col = 2 Then _
      cel.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    i = i + 1
  Next
  .Tables(1).AutoFitBehavior wdAutoFitWindow
End With
'---affichage---
MyWord.Visible = True
AppActivate MyWord.Caption
MyDoc.Activate
Set MyWord = Nothing
Set MyDoc = Nothing
End Sub

Fichiers joints.

Il me semble que l'exécution était plus rapide avec la macro dans Word.

A+

 

[Delux]

[RESOLU] Import d'information d'Excel vers fichier Word

Bonjour Job75,

Merci pour ce code, je vais le garder de cote.
En tous cas, je vais garder la version WORD qui me semble plus appropriee a mes besoins

Encore merci

Cordialement,

Delux