Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Un exemple pour copier la plage de cellule d'Excel vers l'application Word dans un nouveau document. À toi d'adapter!
'-------------------------------------------------------- Sub test() 'Requiert l'ajoute la la référence : '"Microsoft Word xx.x Objects Librairy"
Dim Rg As Range, NbColonne As Long Dim Wd As Word.Application Dim Dc As Document, C As Column Dim T As Table, P As Row Dim A As Integer, B As Integer Dim Bb As Border, Are As Range Static Col As Long Col = 0
'Définir la plage à copier With Worksheets("EmInfo") Derligne = .Range("F52").End(xlUp).Row Set Rg = Union(.Range("A11:B" & Derligne), .Range("F11:H" & Derligne)) End With
'Détermine le nombre de colonnes à copier '(pour des plages non adjacentes) For Each Are In Rg.Areas NbColonne = NbColonne + Are.Columns.Count Next
'Créer une instance de l'application Word Set Wd = CreateObject("Word.Application") Wd.Visible = True 'Ajoute un nouveau document Set Dc = Wd.Documents.Add
'Ajoute un tableau dans Word Set T = Dc.Tables.Add(Range:Ü.Range, _ NumRows:=Rg.Rows.Count, _ NumColumns:=NbColonne)
'Copie la plage de cellules vers Word For Each Are In Rg.Areas For B = 1 To Are.Columns.Count Col = Col + 1 For A = 1 To Are.Rows.Count T.Cell(A, Col).Range = Are(A, B) Next Next Next Col = 0 'Ajoute les bordures au tableau dans Word si nécessaire With T For Each C In .Range.Columns C.Borders(wdBorderHorizontal).Visible = True Next For Each P In .Range.Rows P.Borders(wdBorderVertical).Visible = True Next For A = -4 To -1 .Range.Borders(A) = True Next End With
End Sub '--------------------------------------------------------
Bonjour,
Un exemple pour copier la plage de cellule d'Excel vers l'application
Word dans un nouveau document. À toi d'adapter!
'--------------------------------------------------------
Sub test()
'Requiert l'ajoute la la référence :
'"Microsoft Word xx.x Objects Librairy"
Dim Rg As Range, NbColonne As Long
Dim Wd As Word.Application
Dim Dc As Document, C As Column
Dim T As Table, P As Row
Dim A As Integer, B As Integer
Dim Bb As Border, Are As Range
Static Col As Long
Col = 0
'Définir la plage à copier
With Worksheets("EmInfo")
Derligne = .Range("F52").End(xlUp).Row
Set Rg = Union(.Range("A11:B" & Derligne), .Range("F11:H" & Derligne))
End With
'Détermine le nombre de colonnes à copier
'(pour des plages non adjacentes)
For Each Are In Rg.Areas
NbColonne = NbColonne + Are.Columns.Count
Next
'Créer une instance de l'application Word
Set Wd = CreateObject("Word.Application")
Wd.Visible = True
'Ajoute un nouveau document
Set Dc = Wd.Documents.Add
'Ajoute un tableau dans Word
Set T = Dc.Tables.Add(Range:Ü.Range, _
NumRows:=Rg.Rows.Count, _
NumColumns:=NbColonne)
'Copie la plage de cellules vers Word
For Each Are In Rg.Areas
For B = 1 To Are.Columns.Count
Col = Col + 1
For A = 1 To Are.Rows.Count
T.Cell(A, Col).Range = Are(A, B)
Next
Next
Next
Col = 0
'Ajoute les bordures au tableau dans Word si nécessaire
With T
For Each C In .Range.Columns
C.Borders(wdBorderHorizontal).Visible = True
Next
For Each P In .Range.Rows
P.Borders(wdBorderVertical).Visible = True
Next
For A = -4 To -1
.Range.Borders(A) = True
Next
End With
End Sub
'--------------------------------------------------------
Un exemple pour copier la plage de cellule d'Excel vers l'application Word dans un nouveau document. À toi d'adapter!
'-------------------------------------------------------- Sub test() 'Requiert l'ajoute la la référence : '"Microsoft Word xx.x Objects Librairy"
Dim Rg As Range, NbColonne As Long Dim Wd As Word.Application Dim Dc As Document, C As Column Dim T As Table, P As Row Dim A As Integer, B As Integer Dim Bb As Border, Are As Range Static Col As Long Col = 0
'Définir la plage à copier With Worksheets("EmInfo") Derligne = .Range("F52").End(xlUp).Row Set Rg = Union(.Range("A11:B" & Derligne), .Range("F11:H" & Derligne)) End With
'Détermine le nombre de colonnes à copier '(pour des plages non adjacentes) For Each Are In Rg.Areas NbColonne = NbColonne + Are.Columns.Count Next
'Créer une instance de l'application Word Set Wd = CreateObject("Word.Application") Wd.Visible = True 'Ajoute un nouveau document Set Dc = Wd.Documents.Add
'Ajoute un tableau dans Word Set T = Dc.Tables.Add(Range:Ü.Range, _ NumRows:=Rg.Rows.Count, _ NumColumns:=NbColonne)
'Copie la plage de cellules vers Word For Each Are In Rg.Areas For B = 1 To Are.Columns.Count Col = Col + 1 For A = 1 To Are.Rows.Count T.Cell(A, Col).Range = Are(A, B) Next Next Next Col = 0 'Ajoute les bordures au tableau dans Word si nécessaire With T For Each C In .Range.Columns C.Borders(wdBorderHorizontal).Visible = True Next For Each P In .Range.Rows P.Borders(wdBorderVertical).Visible = True Next For A = -4 To -1 .Range.Borders(A) = True Next End With
End Sub '--------------------------------------------------------
JP
Bonjour Denis,
Merci je vais regarder çà. En fait je serai aussi amené à faire un copié/collé vers un agenda en ligne.
JP
Bonjour Denis,
Merci je vais regarder çà.
En fait je serai aussi amené à faire un copié/collé vers un agenda en ligne.