IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
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

VBA Word Discussion :

Rechercher deux types de suite de mots pour les lister [WD-2016]


Sujet :

VBA Word

  1. #1
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut Rechercher deux types de suite de mots pour les lister
    Bonjour à tous en cette période bien particulière ,

    Je suis à la recherche d'une macro word qui me permettrait de rechercher dans un document, 2 types de suite de mots tels que :
    - "<AGP [! ]@>"
    - "<A[0-9]{5}>"

    J'ai réussi évidemment à rechercher chacune de ces listes indépendamment , mais impossible pour la recherche combinée des 2 .

    Le but étant par la suite de copier la recherche pour la coller dans un tableau.

    Ainsi, j'ai ceci pour l'instant ...

    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
    Sub Sigle()
    Dim Sigle As String, Liste As String
     
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
     
    'Recherche de toutes les expressions sous la forme "AGP [! ]@"
        Do
            Selection.Find.ClearFormatting
                With Selection.Find
                    .ClearFormatting
                    .Text = "<AGP [! ]@>"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                End With
     
        If Selection.Find.Found Then
            Sigle = Selection.Text
                    If InStr(Liste, Sigle) = 0 Then
                        Liste = Liste & Sigle & vbCr
                    End If
        End If
        Loop Until Not Selection.Find.Found
     
    'Aller au tableau Reference Interne
        Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:=""
     
    'Insérer les expressions
        Selection.TypeText Text:=Liste
    Merci pour votre future aide
    Fichiers attachés Fichiers attachés

  2. #2
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Bonjour,

    Voua avez un exemple à mettre en ligne ? (en .Zip)

  3. #3
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut Pièce jointe
    En pièce jointe, le document de référence.Macro.zip

  4. #4
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    En pièce jointe, le document de référence.
    Bonjour,

    J'ai rêvé ? Il n'y avait pas de fichier dans votre premier message, n'est ce pas ?

  5. #5
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    Bonjour,

    Disons que si, il y était, mais impossible à voir sur mon smartphone. J'ai donc décidé d'en faire un message dans la discussion. Mieux vaut 2 fois qu'une

  6. #6
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Disons que si, il y était, mais impossible à voir sur mon smartphone. J'ai donc décidé d'en faire un message dans la discussion. Mieux vaut 2 fois qu'une
    alzheimer a encore frappé, cela devient inquiétant

    Sinon j'ai regardé, je pense qu'il faut passer par une variable dictionnaire. Je vous tiens au courant, enfin si je n'oublie pas...

  7. #7
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Bonjour à tous en cette période bien particulière ,

    Je suis à la recherche d'une macro word qui me permettrait de rechercher dans un document, 2 types de suite de mots tels que :
    - "<AGP [! ]@>"
    - "<A[0-9]{5}>"
    Quand on a ce cas :
    Pièce jointe 548699

    Que faut-il obtenir au final dans la partie référence ? En clair, que veut dire 2 types de suite ?

    J'imagine que ce doit être plus compliqué que ça :

  8. #8
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    C'est exactement ce à quoi je voulais arriver. Alors oui, il y a en plus une classification et une mise en forme, mais aucun soucis pour ça.

  9. #9
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    C'est exactement ce à quoi je voulais arriver. Alors oui, il y a en plus une classification et une mise en forme, mais aucun soucis pour ça.
    Ce serait quoi cette classification et cette mise en forme par exemple ?

  10. #10
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    Ce serait une classification des termes par ordre d'apparition dans le texte, et sous forme de puces et en gras.

  11. #11
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Ce serait une classification des termes par ordre d'apparition dans le texte, et sous forme de puces et en gras.
    ça va coûter une fortune...

  12. #12
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    Voyez ça avec mes supérieurs J'étais seulement venu pour ma première demande, rechercher 2 types de termes

  13. #13
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Voyez ça avec mes supérieurs J'étais seulement venu pour ma première demande, rechercher 2 types de termes
    La solution actuelle est simplissime, il faut répéter deux fois la procédure de recherche sans effacer la variable Liste... En ce qui concerne la dernière demande, je pense qu'il faut repérer le début de chaîne en nombre de caractères depuis l'origine du document et intégrer la valeur dans la variable Liste avec un séparateur permettant de la spliter à la fin. En typant la valeur et en l'ajoutant au nombre de caractères, il sera possible ensuite de lui associer une puce. Possible que je n'ai pas le temps de continuer.

    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
     
    Sub Sigle()
    Dim Sigle As String, Liste As String
     
     
     
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
     
     
    'Recherche de toutes les expressions sous la forme "AGP [! ]@"
        Do
            Selection.Find.ClearFormatting
                With Selection.Find
                    .ClearFormatting
                    .Text = "<AGP [! ]@>"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                End With
     
        If Selection.Find.Found Then
            Sigle = Selection.Text
                    If InStr(Liste, Sigle) = 0 Then
                        Liste = Liste & Sigle & vbCr
                    End If
        End If
        Loop Until Not Selection.Find.Found
     
    'Recherche de toutes les expressions sous la forme "<A[0-9]{5}>"
     Selection.HomeKey Unit:=wdStory
     
        Do
            Selection.Find.ClearFormatting
                With Selection.Find
                    .ClearFormatting
                    .Text = "<A[0-9]{5}>"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                End With
     
        If Selection.Find.Found Then
            Sigle = Selection.Text
                    If InStr(Liste, Sigle) = 0 Then
                        Liste = Liste & Sigle & vbCr
                    End If
        End If
        Loop Until Not Selection.Find.Found
     
     
     
    'Aller au tableau Reference Interne
        Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:=""
     
    'Insérer les expressions
        Selection.TypeText Text:=Liste
     
    End Sub

  14. #14
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    J'étais si prêt du but, mais la solidarité a encore montré qu'elle était indispensable.
    Pour le reste, je suis tout à fait d'accord.
    Merci beaucoup !

  15. #15
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Confidence pour confidence, je ne connaissais pas cette notation "AGP [! ]@"

  16. #16
    Candidat au Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Santé

    Informations forums :
    Inscription : Mars 2020
    Messages : 8
    Points : 3
    Points
    3
    Par défaut
    Oui, ce sont des références produits, et pas n'importe lesquels puisque ce sont les masques tant convoités.

  17. #17
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Samoujdi Voir le message
    Oui, ce sont des références produits, et pas n'importe lesquels puisque ce sont les masques tant convoités.
    Eh bien voilà ma contribution pour le Coronavirus, en espérant que tout le monde puisse avoir des masques au plus vite.
    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
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
     
    Option Explicit
     
    Public MatriceSigles() As Variant, MatriceP() As Variant, MatricePos() As Variant
    Public DicoPos As Object
     
     
    Sub Sigle3()
    Dim Sigle As String, Liste As String
    Dim MaListe As Variant
    Dim I As Integer, IndexMatrice As Integer, IndexP As Integer, IndexPos As Integer
     
    Application.ScreenUpdating = False
    Selection.HomeKey unit:=wdStory
     
     
    'Recherche de toutes les expressions sous la forme "AGP [! ]@"
        Do
            Selection.Find.ClearFormatting
                With Selection.Find
                    .ClearFormatting
                    .Text = "<AGP [! ]@>"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                End With
     
        If Selection.Find.Found Then
            Sigle = Selection.Text
                    If InStr(Liste, Sigle) = 0 Then
                        Liste = Liste & Sigle & vbCr
                    End If
        End If
        Loop Until Not Selection.Find.Found
     
        'Recherche de toutes les expressions sous la forme "<A[0-9]{5}>"
        Selection.HomeKey unit:=wdStory
     
        Do
            Selection.Find.ClearFormatting
                With Selection.Find
                    .ClearFormatting
                    .Text = "<A[0-9]{5}>"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchCase = True
                    .MatchWildcards = True
                    .Execute
                End With
     
        If Selection.Find.Found Then
            Sigle = Selection.Text
                    If InStr(Liste, Sigle) = 0 Then
                        Liste = Liste & Sigle & vbCr
                    End If
        End If
        Loop Until Not Selection.Find.Found
     
        MaListe = Split(Liste, Chr(13))
        IndexMatrice = 0
        For I = LBound(MaListe) To UBound(MaListe)
               ReDim Preserve MatriceSigles(2, IndexMatrice)
               If MaListe(I) <> "" Then
                 MatriceSigles(0, IndexMatrice) = MaListe(I)
                 IndexMatrice = IndexMatrice + 1
               End If
        Next I
     
        RecherchePositionChaine
     
        Liste = ""
        For IndexP = LBound(MatriceP, 2) To UBound(MatriceP, 2)
             For IndexPos = LBound(MatricePos, 2) To UBound(MatricePos, 2)
                 For IndexMatrice = LBound(MatriceSigles, 2) To UBound(MatriceSigles, 2)
                    If MatriceSigles(1, IndexMatrice) = MatriceP(0, IndexP) And MatriceSigles(2, IndexMatrice) = MatricePos(0, IndexPos) Then
                      If MatriceSigles(0, IndexMatrice) <> "" Then Liste = Liste & MatriceSigles(0, IndexMatrice) & vbCr
                    End If
                 Next IndexMatrice
             Next IndexPos
        Next IndexP
     
     
       'Aller au tableau Reference Interne
        Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:=""
     
        'Insérer les expressions
         Selection.TypeText Text:=Liste
     
        PresentationDeLaListe
        'Debug.Print Liste
     
     
    End Sub
     
     
    Sub RecherchePositionChaine()
     
    Dim I As Integer, J As Integer, PositionTexte As Integer, IndexP As Integer, IndexPos As Integer, NbPos As Integer
    Dim Tempo1 As Variant
     
        Set DicoPos = CreateObject("Scripting.Dictionary")
     
        With ActiveDocument
             IndexP = 0
             IndexPos = 0
             NbPos = 0
     
             For J = 1 To .Paragraphs.Count
                 .Paragraphs(J).Range.Select
                ' Continuer = True
                 For I = LBound(MatriceSigles, 2) To UBound(MatriceSigles, 2)
                     PositionTexte = InStr(1, Selection.Range, MatriceSigles(0, I), vbTextCompare)
     
                     If Not DicoPos.Exists(CStr(PositionTexte)) Then
                                DicoPos.Add CStr(PositionTexte), CStr(PositionTexte)
                                ReDim Preserve MatricePos(1, IndexPos)
                                MatricePos(0, IndexPos) = PositionTexte
                                IndexPos = IndexPos + 1
                     End If
     
                     If PositionTexte > 0 And MatriceSigles(1, I) = "" Then
                        MatriceSigles(1, I) = J
                        MatriceSigles(2, I) = PositionTexte
     
                        If J > IndexP Then
                           ReDim Preserve MatriceP(1, IndexP)
                           MatriceP(0, IndexP) = J
                           IndexP = IndexP + 1
                        End If
     
                    End If
                 Next I
             Next J
     
             ' Tri des positions par ordre croissant
             '--------------------------------------
             For I = LBound(MatricePos, 2) To UBound(MatricePos, 2)
                 For J = I To UBound(MatricePos, 2)
                     If MatricePos(0, I) > MatricePos(0, J) Then
                           Tempo1 = MatricePos(0, J)
                           MatricePos(0, J) = MatricePos(0, I)
                           MatricePos(0, I) = Tempo1
                     End If
                  Next J
             Next I
     
      End With
     
      Set DicoPos = Nothing
     
    End Sub
     
     
    Sub PresentationDeLaListe()
     
        Selection.SelectCell
        With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
            .NumberFormat = ChrW(61623)
            .TrailingCharacter = wdTrailingTab
            .NumberStyle = wdListNumberStyleBullet
            .NumberPosition = CentimetersToPoints(0.1)
            .Alignment = wdListLevelAlignLeft
            .TextPosition = CentimetersToPoints(0.5)
            .TabPosition = wdUndefined
            .ResetOnHigher = 0
            .StartAt = 1
            With .Font
                .Bold = wdUndefined
                .Italic = wdUndefined
                .StrikeThrough = wdUndefined
                .Subscript = wdUndefined
                .Superscript = wdUndefined
                .Shadow = wdUndefined
                .Outline = wdUndefined
                .Emboss = wdUndefined
                .Engrave = wdUndefined
                .AllCaps = wdUndefined
                .Hidden = wdUndefined
                .Underline = wdUndefined
                .Color = wdUndefined
                .Size = wdUndefined
                .Animation = wdUndefined
                .DoubleStrikeThrough = wdUndefined
                .Name = "Symbol"
            End With
            .LinkedStyle = ""
        End With
        ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
        Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
            False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
            wdWord10ListBehavior
    End Sub
    Pièce jointe 549173

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. WPF Récuperer les données d'un datagrid pour les lister dans un autre datagrid .
    Par Neoxeone dans le forum Windows Presentation Foundation
    Réponses: 0
    Dernier message: 01/04/2019, 13h04
  2. Réponses: 6
    Dernier message: 22/01/2016, 10h27
  3. Réponses: 1
    Dernier message: 08/07/2011, 11h23
  4. Recherche outil type mysql Front pour LINUX
    Par PamelaGeek dans le forum Outils
    Réponses: 1
    Dernier message: 11/04/2006, 12h12

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