Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut Recherche de mots entourés de deux '*'

    Bonjour,
    je cherche actuellement à faire une macro qui recherche tout les mots du type *FDSDFSFHSDHQ* pour pouvoir modifier leur police. Le point commun des ces mots est qu'ils commencent et finissent tous par *.
    Je sais déjà comment modifier la police et tout le reste, juste je ne sais pas comment trouver tout les mots avec cette forme.
    Cordialement,
    tetetete

  2. #2
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Bonjour,

    A tester :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    55
    56
    57
    58
    59
    60
    61
    62
     
    Option Explicit
     
    Sub RechercheEntreEtoiles()
     
    Dim I As Long, IndexMatrice As Long
    Dim DocEnCours As Document
    Dim MatriceEtoiles() As Variant
    Dim MonRange As Range
    Dim PositionCaractere As Integer
     
       On Error GoTo Fin
     
       Set DocEnCours = ActiveDocument
     
       With DocEnCours
     
            .Range.HighlightColorIndex = wdAuto
     
            IndexMatrice = 0
            PositionCaractere = 0
            For I = 1 To .Characters.Count
                If .Characters(I).Text = "*" Then
                    If PositionCaractere = 0 Then
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                       PositionCaractere = 1
                    Else
                       MatriceEtoiles(1, IndexMatrice) = I
                       IndexMatrice = IndexMatrice + 1
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                    End If
                End If
            Next I
     
            For IndexMatrice = LBound(MatriceEtoiles, 2) To UBound(MatriceEtoiles, 2)
                Set MonRange = Selection.Range
                MonRange.SetRange MatriceEtoiles(0, IndexMatrice), MatriceEtoiles(1, IndexMatrice)
                With MonRange
                  If .Words.Count = 3 Then
                      MatriceEtoiles(2, IndexMatrice) = MonRange.Text
                      With MonRange
                           .HighlightColorIndex = wdYellow
                           ' Suite de la mise en forme....
     
                      End With
                   End If
               End With
               Set MonRange = Nothing
            Next IndexMatrice
     
       End With
     
       GoTo Fin
     
    Fin:
     
       Set MonRange = Nothing
       Set DocEnCours = Nothing
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Bonjour,
    Tout d'abord merci de ton aide.
    Cependant, j'ai un problème, lorsque je lance la macro, word ne répond plus. Je pense que la cause est le fait qu'il y ait environ 10 000 mots dans mon documents et que la macro les parcourt tous.
    Si tu as une solution,
    Cordialement,
    tetetete

  4. #4
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Encadrez le code avec des Application.ScreenUpdating mais pas sur que cela change grand chose.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
     
    Sub RechercheEntreEtoiles()
     
    Dim I As Long, IndexMatrice As Long
    Dim DocEnCours As Document
    Dim MatriceEtoiles() As Variant
    Dim MonRange As Range
    Dim PositionCaractere As Integer
     
       On Error GoTo Fin
     
       Application.ScreenUpdating = False
       Set DocEnCours = ActiveDocument
     
       With DocEnCours
     
            .Range.HighlightColorIndex = wdAuto
     
            IndexMatrice = 0
            PositionCaractere = 0
            For I = 1 To .Characters.Count
                If .Characters(I).Text = "*" Then
                    If PositionCaractere = 0 Then
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                       PositionCaractere = 1
                    Else
                       MatriceEtoiles(1, IndexMatrice) = I
                       IndexMatrice = IndexMatrice + 1
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                    End If
                End If
            Next I
     
            For IndexMatrice = LBound(MatriceEtoiles, 2) To UBound(MatriceEtoiles, 2)
                Set MonRange = Selection.Range
                MonRange.SetRange MatriceEtoiles(0, IndexMatrice), MatriceEtoiles(1, IndexMatrice)
                With MonRange
                  If .Words.Count = 3 Then
                      MatriceEtoiles(2, IndexMatrice) = MonRange.Text
                      With MonRange
                           .HighlightColorIndex = wdYellow
                           ' Suite de la mise en forme....
     
                      End With
                   End If
               End With
               Set MonRange = Nothing
            Next IndexMatrice
     
       End With
     
     
       GoTo Fin
     
    Fin:
     
       Application.ScreenUpdating = True
     
       Set MonRange = Nothing
       Set DocEnCours = Nothing
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  5. #5
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Je l'avais déjà fait et cela ne change rien.

  6. #6
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Je viens de tester sur un page, cela prend un peu de temps mais la macro s'execute.
    Il y a juste un problème sur la deuxième partie du code.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    For IndexMatrice = LBound(MatriceEtoiles, 2) To UBound(MatriceEtoiles, 2)
                Set MonRange = Selection.Range
                MonRange.SetRange MatriceEtoiles(0, IndexMatrice), MatriceEtoiles(1, IndexMatrice)
                With MonRange
                  If .Words.Count = 3 Then
                      MatriceEtoiles(2, IndexMatrice) = MonRange.Text
                      MsgBox "test"
                      With MonRange
                           '.HighlightColorIndex = wdYellow
                           ' Suite de la mise en forme....
                           '.Font.Name = "Code 3 de 9"
                      End With
                   End If
               End With
               Set MonRange = Nothing
            Next IndexMatrice
    Sur cette ligne : If .Words.Count = 3 Then la condition n'est surement pas validé et donc je ne peux pas changer la mise en forme

  7. #7
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Et si vous expliquiez dans quel contexte vous utilisez ce code ? Comment arrivent ces ""*" dans votre document ?
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  8. #8
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Je vous est joint mon fichier.
    En fait le but est de transformer les mots *SDFSDFSDF* en code barre.
    Je vous ai mis en exemple une page, il y en a une 20ène similaire.
    Fichiers attachés Fichiers attachés

  9. #9
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Créez une boucle sur la collection Paragraphs du document et testez avec la fonction Instr la présence du caractère * en début de chaîne dans le Range du paragraphe en cours.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  10. #10
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Je ne suis pas sur de très bien comprendre. Pouvez-vous m'expliquer comment faire

  11. #11
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Je ne suis pas sur de très bien comprendre. Pouvez-vous m'expliquer comment faire
    Pour la boucle, vous avez déjà le modèle dans la macro que je vous ai fournie, il faut juste remplacer la collection Characters par la collection Paragraphs. En suite, il faut tester du paragraphe en cours dans la boucle. Quant à la fonction INSTR, la première chose à faire est d'aller voir son utilisation dans l'aide en ligne VBA Word ou de requéter le forum VBA Word pour récupérer des exemples. Cette fonction permet de vérifier la position d'un caractère ou d'une chaîne à l'intérieur d'une autre chaîne (ici .Paragraphs(I).Range.Text)., si le résultat = 1 cela signifie que la chaîne commence par *.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  12. #12
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    J'ai fait ceci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    Sub RechercheEntreEtoiles()
     
    Application.ScreenUpdating = False
     
     
    Dim I As Long, IndexMatrice As Long
    Dim DocEnCours As Document
    Dim MatriceEtoiles() As Variant
    Dim MonRange As Range
    Dim PositionCaractere As Integer
     
       On Error GoTo Fin
     
       Set DocEnCours = ActiveDocument
      'LENTEUR EXTREME
       With DocEnCours
     
            .Range.HighlightColorIndex = wdAuto
     
            IndexMatrice = 0
            PositionCaractere = 0
     
            For I = 1 To .Paragraphs.Count
            If InStr(.Paragraphs(I).Range.Text, "*") = 1 Then
                    If PositionCaractere = 0 Then
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                       PositionCaractere = 1
                    Else
                       MatriceEtoiles(1, IndexMatrice) = I
                       IndexMatrice = IndexMatrice + 1
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                    End If
                End If
            Next I
     
            'OK
            For IndexMatrice = LBound(MatriceEtoiles, 2) To UBound(MatriceEtoiles, 2)
                Set MonRange = Selection.Range
                MonRange.SetRange MatriceEtoiles(0, IndexMatrice), MatriceEtoiles(1, IndexMatrice)
                With MonRange
                  If .Words.Count = 3 Then
                      MatriceEtoiles(2, IndexMatrice) = MonRange.Text
                      With MonRange
                           '.HighlightColorIndex = wdYellow
                           ' Suite de la mise en forme....
                           .Font.Name = "Code 3 de 9"
                      End With
                   End If
               End With
               Set MonRange = Nothing
            Next IndexMatrice
     
       End With
     
       GoTo Fin
     
    Fin:
     
       Set MonRange = Nothing
       Set DocEnCours = Nothing
     
        Application.ScreenUpdating = True
     
     
     
    End Sub
    Le code est instantané, il me semble que cela marche sauf le problème que j'avais auparavant au niveau de la ligne : If .Words.Count = 3 Then

  13. #13
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Le code initial correspond au cas où plusieurs chaînes coexistent dans une même ligne. Si vous analysez votre fichier, il n'y pas d'autres cas où une chaîne de caractères dans un paragraphe commence par *. Donc, si la condition avec Instr = 1, la chaine du paragraphe correspond à ce que vous cherchez, il n'est pas utile de tester le nombre de mots de la chaîne.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    Sub RechercheEntreEtoilesV2()
     
    Dim I As Long
    Dim DocEnCours As Document
     
       On Error GoTo Fin
     
       Application.ScreenUpdating = False
     
       Set DocEnCours = ActiveDocument
       With DocEnCours
     
            .Range.HighlightColorIndex = wdAuto
     
     
            For I = 1 To .Paragraphs.Count
                If InStr(1,.Paragraphs(I).Range.Text, "*") = 1 Then
                    With .Paragraphs(I).Range
                       '  .HighlightColorIndex = wdYellow
                         .Font.Name = "Code 3 de 9"
                    End With
                End If
            Next I
     
       End With
     
       GoTo Fin
     
    Fin:
     
        Set DocEnCours = Nothing
     
        Application.ScreenUpdating = True
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  14. #14
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Cela marche bien pour l'exemple que je t'ai donné mais cela marche moins bien pour d'autres. Je te joint un nouveau fichier *CAROUS....* ne devient un code barre et d'autres sont buggés, globalement tout ceux à droite.
    Fichiers attachés Fichiers attachés

  15. #15
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Il faut combiner les deux codes. Avec Instr, tester le range de chaque paragraphe. Si une * est trouvée, décompter les nombre d'étoiles dans le range sachant que le nombre d'étoiles est forcément pair. Il faut donc analyser caractère par caractère le range du paragraphe en cours (seulement ceux contenant au moins une étoile) et mémoriser dans la matrice les positions paires et impaires des caractères *.

    Ensuite, mettre en forme avec le même code qu'initialement. Dans le code initial, on testait le nombre de mots dans la chaîne (3 : 2 pour les *, 1 pour le mot). Dans ce dernier document, les points correspondent à des mots. Mais avec le principe que les étoiles apparaissent par paires, ce test n'est plus nécessaire.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  16. #16
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    J'ai essayé de modifier comme vous me l'avez dit mais ça ne marche pas.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    55
    56
    57
    58
    59
    60
    61
    Sub RechercheEntreEtoiles()
     
    Dim I As Long, IndexMatrice As Long
    Dim DocEnCours As Document
    Dim MatriceEtoiles() As Variant
    Dim MonRange As Range
    Dim PositionCaractere As Integer
     
       On Error GoTo Fin
     
       Application.ScreenUpdating = False
     
       Set DocEnCours = ActiveDocument
       With DocEnCours
     
            .Range.HighlightColorIndex = wdAuto
     
            For I = 1 To .Paragraphs.Count
                If InStr(1, .Paragraphs(I).Range.Text, "*") = 1 Then
                    If PositionCaractere = 0 Then
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                       PositionCaractere = 1
                    Else
                       MatriceEtoiles(1, IndexMatrice) = I
                       IndexMatrice = IndexMatrice + 1
                       ReDim Preserve MatriceEtoiles(2, IndexMatrice)
                       MatriceEtoiles(0, IndexMatrice) = I - 1
                    End If
                End If
            Next I
     
     
            For IndexMatrice = LBound(MatriceEtoiles, 2) To UBound(MatriceEtoiles, 2)
                Set MonRange = Selection.Range
                MonRange.SetRange MatriceEtoiles(0, IndexMatrice), MatriceEtoiles(1, IndexMatrice)
                With MonRange
                  If .Words.Count = 3 Then
                      MatriceEtoiles(2, IndexMatrice) = MonRange.Text
                      With MonRange
                           '.HighlightColorIndex = wdYellow
                           ' Suite de la mise en forme....
                           .Font.Name = "Code 3 de 9"
     
                      End With
                   End If
               End With
               Set MonRange = Nothing
            Next IndexMatrice
     
       End With
     
       GoTo Fin
     
    Fin:
     
        Set DocEnCours = Nothing
     
        Application.ScreenUpdating = True
     
    End Sub

  17. #17
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    On voit dans ce vidage d'écran que le document est composé de sauts de colonnes qui visiblement ne permettent pas d'identifier la position des * depuis le début de document.
    Ce document doit-il rester dans sa forme initiale ?
    Nom : Capture.JPG
Affichages : 22
Taille : 101,1 Ko
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  18. #18
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Le mieux serait qu'il reste dans sa forme originale mais il peut être changé tant que de la ligne push jusqu'a la ligne avec cette forme *DFGDFGSDDF* sont groupés

  19. #19
    Expert éminent sénior

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    3 956
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 3 956
    Points : 10 087
    Points
    10 087
    Billets dans le blog
    27

    Par défaut

    Citation Envoyé par tetetete Voir le message
    Testez cette solution bâtie à partir de signets :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
     
    Public DocEnCours As Document
     
    Sub RechercheEntreEtoilesV3()
     
     
    Dim I As Long, CaractereEnCours As Long
    Dim MonRange As Range
    Dim IndexSignet As Integer
     
       On Error GoTo Fin
     
      ' Application.ScreenUpdating = False
     
       Set DocEnCours = Documents("exemple (2).docx") 'ActiveDocument
      ' Set DocEnCours = ActiveDocument
     
       With DocEnCours
     
            For I = .Bookmarks.Count To 1 Step -1
                .Bookmarks(I).Delete
            Next I
            IndexSignet = 1
     
            .Range.HighlightColorIndex = wdAuto
     
            For I = 1 To .Paragraphs.Count
                .Paragraphs(I).Range.Select
                If InStr(1, .Paragraphs(I).Range.Text, "*", vbTextCompare) > 0 Then
                  .Paragraphs(I).Range.Select
                  With Selection
                       If IndexSignet < 10 Then
                          .Bookmarks.Add Name:="Signet0" & IndexSignet
                       Else
                          .Bookmarks.Add Name:="Signet" & IndexSignet
                       End If
                       IndexSignet = IndexSignet + 1
                  End With
                End If
            Next I
     
            If IndexSignet > 0 Then
               For I = 1 To .Bookmarks.Count
                   EssaiSignet DocEnCours, .Bookmarks(I)
               Next I
            End If
     
       End With
     
       GoTo Fin
     
    Fin:
     
       Set MonRange = Nothing
       Set DocEnCours = Nothing
     
      '  Application.ScreenUpdating = True
     
    End Sub
     
     
     
    Sub EssaiSignet(ByVal DocEnCours2 As Document, ByVal MonSignet2 As Bookmark)
     
    Dim MonRange1 As Range, MonRange2 As Range
    Dim J As Long, Pos1 As Long, Pos2 As Long
    Dim MesCaracteres As String
    Dim MesPositions As Variant
     
       With DocEnCours2
     
            With MonSignet2
                 Pos1 = .Range.Start
                 Pos2 = .Range.End
            End With
     
            Set MonRange1 = .Range(Start:=Pos1, End:=Pos2)
     
            MesCaracteres = ""
            For J = 1 To Len(MonRange1.Text)
                If Mid(MonRange1.Text, J, 1) = "*" Then
                   MesCaracteres = MesCaracteres & J & "-"
                End If
            Next J
     
            If Len(MesCaracteres) > 0 Then
     
               MesCaracteres = Mid(MesCaracteres, 1, Len(MesCaracteres) - 1)
               MesPositions = Split(MesCaracteres, "-")
               For J = LBound(MesPositions) To UBound(MesPositions)
     
                 Select Case J
                        Case 0
                           If Pos1 + MesPositions(J) - 1 = Pos1 Then
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1))
                             With MonRange2
                                  .HighlightColorIndex = wdYellow
                             End With
                              Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
     
                             Set MonRange2 = Nothing
                           Else
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J), End:=Pos1 + MesPositions(J + 1) + 1)
                             With MonRange2
                                  .HighlightColorIndex = wdYellow
                             End With
                              Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) & ", pos2 " & Pos2 + MesPositions(J + 1) + 1
     
                             Set MonRange2 = Nothing
     
     
                           End If
     
                        Case 2, 4
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1))
                             With MonRange2
                                  .HighlightColorIndex = wdYellow
                             End With
                              Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
     
                             Set MonRange2 = Nothing
                 End Select
                Next J
     
            End If
     
            Set MonRange1 = Nothing
     
      End With
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  20. #20
    Nouveau Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    novembre 2018
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 24
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : novembre 2018
    Messages : 13
    Points : 1
    Points
    1

    Par défaut

    Merci beaucoup, cela marche !!
    J'aurais juste 2 petites autres questions , j'aimerai savoir si cela est possible avec de me lancer dans des choses impossibles.

    Est-ce possible de vérifier si un texte avec une police spéciale est en fin de page si non faire des sauts de lignes sur la page pour qu'il soit en fin de page ?
    Ajouter du texte à une entête ? (j'aimerai agrandir mon entête en y ajoutant les noms des colonnes ?

    Cordialement,
    tetetete

Discussions similaires

  1. Recherche mots identiques dans deux tableaux différents
    Par lesurfer dans le forum VBA Word
    Réponses: 2
    Dernier message: 14/07/2017, 15h25
  2. [TP]Recherche de mots dans un Doc.
    Par Loceka dans le forum Turbo Pascal
    Réponses: 8
    Dernier message: 04/10/2004, 19h04
  3. Recherche des mots contenant ...
    Par Asdorve dans le forum Langage SQL
    Réponses: 3
    Dernier message: 18/06/2004, 10h23
  4. Réponses: 10
    Dernier message: 22/05/2004, 13h51
  5. Recherche multi-mots sur une seule colonne
    Par Badiste dans le forum Langage SQL
    Réponses: 2
    Dernier message: 31/03/2004, 11h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo