Sub Copier_vers_Word()
Dim Wapp As Object, Wdoc As Object, tablo, i&, v, a$(), n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Heures.docx")
If Wdoc Is Nothing Then MsgBox "Fichier 'Heures.docx' introuvable !", 48: Exit Sub
On Error GoTo 0
Wdoc.Content = "" 'RAZ
With Feuil1.UsedRange.Columns(1)
If Application.Count(.Cells) = 0 Then Exit Sub
tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
End With
For i = 2 To UBound(tablo)
v = tablo(i, 1)
If IsNumeric(v) Then
ReDim Preserve a(n)
a(n) = Int(24 * v) & ":" & Format(1440 * v - 60 * Int(24 * v), "00")
n = n + 1
End If
Next
Wapp.Selection = Join(a, vbCrLf) 'restitution dans Word
Wdoc.Range(0, 0).Select
AppActivate Wapp.Caption
End Sub