begin process at 2012 05 27 19:23:40
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > 

Code

 > 

Divers

 > SOUS-TITRES : INCRÉMENTATION DE TOUTES LES CHAÎNES DE CARACTÈRES "HH:MM:SS,MMM"

SOUS-TITRES : INCRÉMENTATION DE TOUTES LES CHAÎNES DE CARACTÈRES "HH:MM:SS,MMM"


 Information sur la source

Note :
Aucune note
Catégorie :Divers Classé sous :word, macro, chaines Niveau :Débutant Date de création :05/01/2012 Vu :908
Auteur : ALMIRA

Ecrire un message privé
Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

 Description

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

Source

  • 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 
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!


 Sources de la même categorie

Source avec Zip EDITION D'ÉTIQUETTES SANS OUTIL EXTERNE par ucfoutu
Source avec Zip Source .NET (Dotnet) APPRENDRE À PRONONCER LES MOTS ANGLAIS par alpha5
Source avec Zip Source .NET (Dotnet) AFFICHAGE DE TEXTE DANS UNE PICTUREBOX par alpha5
Source avec Zip TEXTBOX EN NUMÉRIQUE par 320C
Source avec Zip DÉCIMAL TO HEXDECIMAL par loulou27200
Toutes les sources de la catégorie Divers

 Sources en rapport avec celle ci

Source avec Zip Source .NET (Dotnet) EXPORTER LES IMAGES DE WORD ET D' EXCEL par Le Pivert
Source avec Zip UTILISER LES PROPRIÉTÉS PERSO D'UN DOCUMENT COMME PARAMETRES... par bigfish_le vrai
Source avec Zip FREEBOOK : MODELE ET MACRO WORD EBOOK POUR LES LISEUSES ELEC... par Patrice99
Source avec une capture ENCODER UNE URL EN UTF8 DEPUIS WORD par VBsnail
Source avec Zip WORD : OUVERTURE (AVEC OU SANS PASSWORD) ET PROPRIÉTÉES D'UN... par DJMoustique

Commentaires et avis

Commentaire de Renfield le 05/01/2012 08:40:07 administrateur CS

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

Commentaire de ALMIRA le 05/01/2012 23:16:31

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

Commentaire de Renfield le 06/01/2012 07:06:44 administrateur CS

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^^

Commentaire de jack le 06/01/2012 19:10:33 administrateur CS

Attention : Minute est un mot clé du langage, donc à bannir des noms de variables

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Lancer une macro au démarrage d'un fichier Word [ par Super Franck ] Comment lancer automatiquement une macro au démarrage d'un fichier Word Macro Word: insertion champs de fusion [ par Laurent ] J'ai besoin d'écrire une macro qui me permette d'insérer dans mon document word un champ de fusion qui pourra prendre deux valeurs lors de la fusion e executer macro word à l'ouverture de word [ par kkm ] SVP,Je souhaite executer une fusionde doc sous word en la lançant à partir d'un formulaire vb. Par exemple un utilisateur A clique sur un bouton qui f editer un formulaire WORD depuis macro EXCEL [ par Yann ] Bonjour tous,De cherche désespérément la commande qui me permettra de modifier un texte dans un fichier word en mode formulaire.j'arrive à atteindre l macro word [ par dam ] Bonjour, je souhaiterai exécuter une macro sur un document word stocké sur mon serveur à partir d'une page html.Est-ce possible et si oui comment ?Mer pb de macro word + formulaire [ par steph ] Bonjour Ce que je veux faire : Je rempli un formulaire (fait sous vb editor)Puis chaque zone de ce formulaire je le positionnne a un endroit bien pr Lancer macro word automatiquement [ par one ] Bonjour,Je suis un debutant en VBA. Voila j'ai developpe une appli avec word (alt+f11). Le probleme est que pour lancer cet appli je suis oblige de pa MACRO WORD !! need help !! [ par kimsRE ] help me !!!comment tester dans une macro word en vb si on est sur la derniere page d'un document ???exemple : verifier ke dans un document de X je sui MACRO WORD !! need help !! [ par kimsRE ] help me !!!comment tester dans une macro word en vb si on est sur la derniere page d'un document ???exemple : verifier ke dans un document de X je sui Pb de bibliothèque dans une macro Word [ par rutabaga ] J'ai écrit une macro Word AutoNew. Elle fonctionne parfaitement sur ma bécanne. Quand j'installe le .dot contenant cette macro sur d'autres bécannes a


Nos sponsors


Sondage...

CalendriCode

Mai 2012
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

Consulter la suite du CalendriCode

A découvrir
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,764 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib (Android Market)