Mise en page WORD extraction sous titre YOUTUBE

Fermé
INFSON Messages postés 21 Date d'inscription lundi 17 août 2020 Statut Membre Dernière intervention 9 décembre 2022 - 3 oct. 2021 à 15:30
INFSON Messages postés 21 Date d'inscription lundi 17 août 2020 Statut Membre Dernière intervention 9 décembre 2022 - 7 oct. 2021 à 14:03
Bonjour

Besoin d'une aide pour améliorer le résultat d'une extraction de sous-titre Youtube

En suivant la méthode proposée dans webmarketing-debutant.fr
j'ai récupéré un fichier txt d'extraction des sous-titres Youtube de la vidéo
Le dernier Empereur romain d'occident
https://www.youtube.com/watch?v=0EAt-9QO3JY&t=17s&ab_channel=L%26%2339%3Ba%C3%A8de

J'ai obtenu un fichier txt
https://www.cjoint.com/c/KJdng26OeL4


j'ai transposé dans un fichier Word
https://www.cjoint.com/c/KJdnvbp0aY4


J'aimerai améliorer le rendu afin d'avoir un fichier où chaque ligne comporte le maximun de caractères possibles en remplissant la totalité de l'espace disponible sur la droite

Peut être une solution en VBA ?

Merci d'avance cordialement

2 réponses

cs_Le Pivert Messages postés 7883 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 18 mars 2023 724
6 oct. 2021 à 16:23
Bonjour,

en passant par Excel:

Importer les données du fichier texte:

allez dans le ruban: Données à partir du texte.

ensuite supprimer les lignes vides

ensuite déplacer le texte:

Option Explicit
'supprimer lignes vides
Sub Supprimer_si_vide()
    Dim Ligne As Long
    On Error Resume Next
    Ligne = Columns("A").Find("*", , , , , xlPrevious).Row
   Range("A2:A" & Ligne).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
'déplacer le texte
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne A
    For NoLig = Split(FL1.UsedRange.Address, "$")(4) To 2 Step -2
        Var = FL1.Cells(NoLig, NoCol)
       FL1.Cells(NoLig - 1, NoCol) = FL1.Cells(NoLig - 1, NoCol) & " " & Var
     Rows(NoLig & ":" & NoLig).Delete Shift:=xlUp
    Next
    Set FL1 = Nothing
    Worksheets("Feuil1").Columns("A:A").AutoFit
End Sub


il ne reste plus qu'à copier coller dans le document Word

voilà
0
INFSON Messages postés 21 Date d'inscription lundi 17 août 2020 Statut Membre Dernière intervention 9 décembre 2022
7 oct. 2021 à 14:03
Super ça fonctionne nickel

Merci
0