Sous-titres : incrémentation de toutes les chaînes de caractères "hh:mm:ss,mmm"

Soyez le premier à donner votre avis sur cette source.

Snippet vu 2 938 fois - Téléchargée 19 fois

Contenu du snippet

Petite macro word servant à incrémenter toutes les chaînes de caractères codant le temps dans un sous-titre.

Source / Exemple :


Sub IncrementTempo()
    
    Dim ToutLeSub As String
    Dim TexteFinal As String
    Dim ligne As String
    Dim carac As String
    
    Dim increment As Long
    
    Dim LongueurSub As Integer
    Dim i As Integer
    
    TexteFinal = ""
    increment = InputBox("temps additionnel en millisecondes", "Tempo")
    
    'selection de tout le texte
    Selection.WholeStory
    ToutLeSub = Selection
    LongueurSub = Len(ToutLeSub)
    
    'decoupage ligne a ligne
    For i = 1 To LongueurSub
        
        'caractere lu
        carac = Mid(ToutLeSub, i, 1)
        
        'detection retour a la ligne (caractere de valeur 13)
        If Asc(carac) <> 13 Then ligne = ligne + carac Else TexteFinal = TexteFinal + ReecritureSub(ligne, increment)
        
    Next

    Selection.TypeText (TexteFinal)

End Sub

Function ReecritureSub(texte As String, increment As Long) As String
    
    'detection lignes de tempo contenant la chaine "-->"
    If Mid(texte, 13, 5) = " --> " Then texte = IncremTempo(texte, increment)
    
    'obtention texte finale avec les tempos modifiees
    ReecritureSub = texte + vbCr
    
    'RAZ de la ligne
    texte = ""
    
End Function

Function IncremTempo(texte As String, increment As Long) As String

    Dim PremiereTempo As String
    Dim SecondeTempo As String
        
    PremiereTempo = Mid(texte, 1, 13)
    SecondeTempo = Mid(texte, 18, 13)
    
    IncremTempo = AdditionTempo(PremiereTempo, increment) + " --> " + AdditionTempo(SecondeTempo, increment)
    

End Function

Function AdditionTempo(texte As String, increment As Long) As String

    Dim heure As Integer
    Dim minute As Integer
    Dim seconde As Integer
    Dim millisec As Integer
    
    heure = Mid(texte, 1, 2) + (increment \ 3600000)
    minute = Mid(texte, 4, 2) + (increment \ 60000) - ((increment \ 3600000) * 60)
    seconde = Mid(texte, 7, 2) + (increment \ 1000) - ((increment \ 60000) * 60)
    millisec = Mid(texte, 10, 3) + increment - ((increment \ 1000) * 1000)
    
    While (millisec >= 1000)
        millisec = millisec - 1000
        seconde = seconde + 1
    Wend
    
    While (seconde >= 60)
        seconde = seconde - 60
        minute = minute + 1
    Wend
    
    While (minute >= 60)
        minute = minute - 60
        heure = heure + 1
    Wend
    
    AdditionTempo = convertFormat(heure, 2) + ":" + convertFormat(minute, 2) + ":" + convertFormat(seconde, 2) + "," + convertFormat(millisec, 3)

End Function

Sub CorrigeValeur(minute As Integer, seconde As Integer, millisec As Integer)
    Do
        millisec = millisec - 1000
        seconde = seconde + 1
    While (millisec > 1000)

End Sub

Function convertFormat(valeur As Integer, longueur As Integer) As String
    convertFormat = valeur
    
    If Len(convertFormat) < longueur Then convertFormat = "0" + convertFormat
    If Len(convertFormat) < longueur Then convertFormat = "0" + convertFormat
    
End Function

Conclusion :


Il s'agit juste d'un exemple qui permettra aux débutants de mieux comprendre la manipulation de chaînes de caractères avec un exemple concret:
00:00:13,835 --> 00:00:21,105
Hello!

A voir également

Ajouter un commentaire

Commentaires

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
68
Attention : Minute est un mot clé du langage, donc à bannir des noms de variables
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
J'aime bien ce genre d'exercice de bon matin, ca permet de garder l'oeil vif ^^

"ça va forcément planter et afficher un message, non?"

oui, mais au moins, là, c'est notre message... et on prend de bonnes habitudes.
macro, ca va, mais sur un programme VB6 (ou dans un UserForm), ce serait plantage direct (avec message) mais fermeture de l'application.
En règle général, tout ce qui vient de l'exterieur doit etre vérifié (saisie, fichier...) un test bien placé peut éviter de lancer des traitements parfois destructeurs

et oui, il s'agit bien d'une expression régulière^^
Messages postés
1
Date d'inscription
lundi 9 février 2004
Statut
Membre
Dernière intervention
5 janvier 2012

Impressionnant Renfield!!!
Je ne m'attendais pas à un commentaire si rapide et de cette qualité, pour ce petit morceau de code. Merci !
Pour être honnête je n'ai pas tout compris, il faut que je me pose tranquillement et que je regarde ça.
D'accord pour utiliser un string au lieu d'un Long...
encore que si l'utilisateur ne rentre pas des chiffres ça va forcément planter et afficher un message, non?
ensuite cela ressemble à une expression régulière, pour enlever les --> et autres signes de ponctuation, ok...
Désolé, je reprends ça un peu plus tard
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
J'ai nettoyé et commenté ton code.

Sub IncrementTempo()
Dim sBuffer As String
Dim nMilliSeconds As Long
Dim oMatch As Object
'# La saisie est une chaîne de caractère.
'# Evite un plantage en cas de saisie incorrecte.
sBuffer = InputBox("temps additionnel en millisecondes", "Tempo")
If Not IsNumeric(sBuffer) Then '# Verifications d'usage...
MsgBox "Saisie incorrecte"
ElseIf CLng(sBuffer) = 0 Then
MsgBox "Aucun décalage a appliquer"
Else
'# On convertit le décalage en numérique
nMilliSeconds = CLng(sBuffer)
With CreateObject("VbScript.Regexp")
'# Permet le ciblage et le découpage des lignes qui nous interessent.
.Pattern = Chr$(11) & "(\d+\:\d+\:\d*)(,?\d*)( +--> +)(\d+\:\d+\:\d*)(,?\d*)"
.Global = True
.Multiline = True
'# On ne touche pas a la selection, ce n'est jamais necessaire et peut perturber l'utilisateur
'# Cela déplace l'ascenseur, fait perdre a l'utilisateur sa selection courante, etc.
For Each oMatch In .Execute(ActiveDocument.Range(1).Text)
With oMatch
'# On reconstitue la chaine, ajoutant le décalage
sBuffer = Chr$(11) & _
AdditionTempo(.subMatches(0), .subMatches(1), nMilliSeconds) & _
.subMatches(2) & _
AdditionTempo(.subMatches(3), .subMatches(4), nMilliSeconds)
'# On remplace la chaine de départ par la notre.
ActiveDocument.Range(.FirstIndex + 1, .FirstIndex + 1 + .Length).Text = sBuffer
End With
Next oMatch
End With
End If
End Sub

'# A un temps donné, va ajouter un nombre de secondes et de millisecondes donné.
'# Le nombre de secondes est la partie décimale lue dans le fichier
Private Function AdditionTempo(ByVal vdTime As Date, ByVal vsSeconds As String, ByVal vnMilliSeconds As Long) As String
'# On cumule la fraction de secondes lue dans le fichier avec le décalage souhaité.
If IsNumeric(vsSeconds) Then
'# On s'arrange avec les virgules ou les points pouvant figurer dans le fichier srt.
'# redondant ? peut etre, mais on s'assure que notre code sera fonctionnel quels que soient les parametres regionnaux
vnMilliSeconds = vnMilliSeconds + CDbl(vsSeconds) * 1000
Else
vnMilliSeconds = vnMilliSeconds + Val(vsSeconds) * 1000
End If

'# On met a jour la date
vdTime = DateAdd("s", CLng(vnMilliSeconds / 1000), vdTime)
'# Et On prépare la partie décimale restante
vnMilliSeconds = vnMilliSeconds - Fix(vnMilliSeconds / 1000) * 1000
If vnMilliSeconds < 0 Then '# Vrai lorsque l'on soustraie un certain nombre de secondes
vnMilliSeconds = vnMilliSeconds + 1000
End If

'# Formatage de la date.
AdditionTempo = Format$(vdTime, "hh:nn:ss") & Format$(vnMilliSeconds, "\,000")
End Function

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.