1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Sub report_texte()
Dim appWord As Object
Dim WordDoc As Object
Dim Fermer_Word As Boolean
Dim Ligne As Long
Dim Texte As String
Dim Lignes() As String
Dim i As Long
Ligne = 1
Fermer_Word = False
On Error Resume Next
' Créer une instance de Word
Set appWord = GetObject(, "Word.Application") ' Vérifie si Word est déjà ouvert
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application") ' Sinon, ouvrir une nouvelle instance
Fermer_Word = True
End If
On Error GoTo 0
Set WordDoc = appWord.Documents.Open("E:\2_M_E_S__P_R_O_J_E_T_S\Périple\5eme_analyse\colonne_LES_MISÉRABLES.docx")
Texte = WordDoc.Content.Text
' Remplacer tous les types de sauts de ligne par un format standard
Texte = Replace(Texte, vbCrLf, vbLf) ' Remplace vbCrLf par vbLf
Texte = Replace(Texte, vbCr, vbLf) ' Remplace vbCr par vbLf
' Séparer le texte en lignes (utilise uniquement vbLf maintenant)
Lignes = Split(Texte, vbLf)
' Transférer chaque ligne dans une cellule Excel
With ThisWorkbook.Sheets("Hugo")
For i = LBound(Lignes) To UBound(Lignes)
If Trim(Lignes(i)) <> "" Then ' Ignorer les lignes vides
.Cells(Ligne, 1).Value = Trim(Lignes(i))
Ligne = Ligne + 1
End If
Next i
End With
' Fermer le document Word
WordDoc.Close False
' Fermer l'application Word si nécessaire
If Fermer_Word Then appWord.Quit
' Libérer les objets
Set WordDoc = Nothing
Set appWord = Nothing
MsgBox "Transfert terminé avec succès*!", vbInformation
End Sub |
Partager