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 :

Modifier automatiquement tous les nombres ordinaux d'un document avec mise en forme exposant


Sujet :

VBA Word

  1. #1
    Nouveau membre du Club
    Homme Profil pro
    Archiviste d'association
    Inscrit en
    Juillet 2017
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : France, Loir et Cher (Centre)

    Informations professionnelles :
    Activité : Archiviste d'association
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2017
    Messages : 12
    Points : 29
    Points
    29
    Par défaut Modifier automatiquement tous les nombres ordinaux d'un document avec mise en forme exposant
    Bonsoir à Tous,

    C'est ma première contribution, après avoir découvert et exploité la grande richesse de ce site depuis deux semaines (vieux maut tard que jamais ).
    Je me lance, ayant fouillé pendant 48h sans trouver de sujet parfaitement similaire. J'espère ne pas être passé à côté de quelque chose, et cela m'a aussi incité à être très précis dans le titre de mon post.
    Je pars d'un (très) long document Word 2003 que j'ai obtenu par numérisation scanner+OCR.
    J'ai construit une longue macro pour traiter tous les problèmes de "rechercher-remplacer" auquel on est confronté en pareil cas.
    J'en arrive au problème des nombres ordinaux, qui obéissent à des règles typographiques assez précises, comme par exemple :

    Remplacer toutes les occurrences "2nd" sans exposant en "2d" avec le "d" en exposant.


    Après avoir beaucoup cherché sur la piste du VBA, j'en suis resté à une solution de paramétrage de Word, plus pârticulièrement des mises en forme automatiques.
    En reprenant l'exemple "2nd" de :

    - Sélectionner une occurrence "2nd" dans le fichier Word
    - Sélectionner le caractère "n" et mettre le caractère "d" en exposant (Maj+Ctrl+=)
    - sélectionner les deux caractères "2d" ("d" étant désormais en exposant).
    Cette sélection est nécessaire pour activer l'option "Texte mise en forme" de la boîte de dialogue que l'on va ouvrir
    - Menu : Insertion\Insertion automatique…\Insertion automatique (Alt+I+E+I)
    - Onglet : Correction automatique
    - Dans la zone Remplacer (à gauche), saisir "2nd"
    - Touche tabulation pour sélectionner à droite la chaîne "2d" qui figure par défaut dans la zone "Par".
    - Cocher l'option "Texte mise en forme" juste au-dessus. Cela a pour effet de mettre les caractères "nd" en exposant
    - Cliquer sur le bouton "Ajouter".
    - Valider la boîte de dialogue avec le bouton "Ok"

    Toutes les occurrences "2nd" sans exposant sont transformées automatiquement en "2d" avec exposant.
    Si on saisit dans le texte une chaîne "2nd" (sans exposant), elle sera transformée en "2d" (Avec exposant)
    Si on lance la commande Format\Mise en forme automatique\Boîte de dialogue : option Mettre en forme automatiquement avec le Document général.

    Mon problème est donc résolu de cette manière, et vu la difficulté que j'ai eu à trouver sur Internet, je n'hésite pas à partager cette solution.
    Néanmoins j'aurai aimé savoir s'il aurait pu être traité par macro ? C'est donc par pure curiosité.
    Avez-vous le souvenir d'avoir déjà travaillé ce sujet ?

    Merci par avance de votre intérêt.

    PS : Le sujet concerne aussi les occurrences "3ème", "4ème", etc, Ier, IIe, etc

  2. #2
    Rédacteur/Modérateur

    Avatar de Heureux-oli
    Homme Profil pro
    Contrôleur d'industrie
    Inscrit en
    Février 2006
    Messages
    21 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 59
    Localisation : Belgique

    Informations professionnelles :
    Activité : Contrôleur d'industrie
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Février 2006
    Messages : 21 087
    Points : 42 926
    Points
    42 926
    Par défaut
    Salut,

    Oui, on peut le faire par VBA.
    Le VBA devient intéressant quand le traitement devient récurrent.

    Jette un œil là : http://heureuxoli.developpez.com/off...-et-remplacer/
    On peut partir d'une liste pour les remplacements.
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  3. #3
    Nouveau membre du Club
    Homme Profil pro
    Archiviste d'association
    Inscrit en
    Juillet 2017
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : France, Loir et Cher (Centre)

    Informations professionnelles :
    Activité : Archiviste d'association
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2017
    Messages : 12
    Points : 29
    Points
    29
    Par défaut
    Bonjour et merci de tes indications Heureux-oli,

    Pardon pour ce délai de réaction; j'ai retourné le problème un peu dans tous les sens, après avoir exploité
    l'exemple du traitement par remplacement à partir d'une liste d'occurrences dans un tableau.
    cf. http://heureuxoli.developpez.com/off...-et-remplacer/
    J'ai tâché de l'adapter à mon cas particulier :

    - Création d'un tableau à deux colonnes sur fichier Word contenant en colonne A les occurrences à rechercher (Melle, Mgr), et en colonne B les occurrences de remplacement (idem qu'en A, sauf que "elle" et "gr" sont formatés en exposant) Cf. fichier ListExposants.doc

    - Création d'un document test sur Word avec le texte contenant les occurrences à modifier. Cf. fichier ExempleTraitementExposants.doc

    - Adaptation du code VBA :

    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
    'Recherche et remplacement d'une liste de mots
    '===============================
    '
    Function NetText(stTemp As String) As String
    '===========================================
    'Fonction de nettoyage
    'Supprime les deux caractères de fin de cellule
    '
    'NetText = Left(stTemp, Len(stTemp) - 2) 'Left(chaîne,nb_caractères à gauche)
                                            'stTemp : variable de chaîne de caractère ?
                                            'Len donne le nombre de caractères d'une chaîne (=nbcar() sur Excel)
    NetText = Left(stTemp, Len(stTemp))'Remplace la ligne précédente, car pas besoin de supprimer les deux caractères de fin de cellule
    End Function
    'Nous l'utiliserons dans la procédure suivante pour obtenir les mots recherchés et les mots de remplacement.
    '
    Sub RemplacerListeDeMots()
    '==================
    'Cette macro a pour rôle de remplacer les mots d'un document par
    'une liste de mots se trouvant dans une table à deux colonnes
    '___________________________________________________
    '
    'Déclaration des variables correspondant aux fichiers
    '----------------------------------------------------
    'Le document oDocSource contient la liste des mots à chercher
    'et le document oDocCible les mots à remplacer
    Dim oDocSource As Document, oDocCible As Document
    '
    'Déclaration des variables Table
    Dim oTbl As Table 'Définition de tableau
    Dim oRow As Row 'Définition de ligne
    '
    'Une boîte de dialogue pour choisir les documents
    Dim oDlg As FileDialog
    '
    '
    'Dans un premier temps, nous allons ouvrir les deux documents, le premier contenant la liste des mots à rechercher
    '(tableau à deux colonnes) et le second étant celui dans lequel nous souhaitons faire les remplacements.
    '
    'Pour ouvrir les documents, au lieu de les mettre en "dur" dans le code, nous allons utiliser un objet "FileDialog".
    'Cet objet permet de sélectionner un répertoire ou un fichier. Dans notre exemple, nous allons l'utiliser pour les fichiers.
    'Ce choix s'obtient par l'argument passé lors de l'affectation.
    '
    Set oDlg = Application.FileDialog(msoFileDialogFilePicker)
    '
    '
    'Ouverture du premier document
    '-----------------------------
    'Ouverture de la boîte de dialogue
    'Pour afficher cette boîte de dialogue, nous allons utiliser sa méthode ".Show".
    'Comme il s'agit d'un échange avec l'utilisateur, nous avons la possibilité de choisir un titre pour la boîte de dialogue
    'et nous n'avons besoin que d'un seul fichier.
    With oDlg
        .AllowMultiSelect = False
        .Title = "Document contenant le tableau des mots avec exposant"
        .Show 'Affichage de la boîte de dialogue. On demande à l'utilisateur
            '  qu'il désigne le fichier avec le tableau
    End With
    'Cet objet va renvoyer le nom du fichier choisi par l'utilisateur.
    'Comme il n'y a qu'un seul fichier, nous récupérons le premier élément.
    '
    'La propriété SelectedItems contient :
    Set oDocSource = Documents.Open(oDlg.SelectedItems(1)) 'Il n'est pas nécessaire
    '               de passer par une variable, nous pouvons directement utiliser
    '               le résultat de oDlg.SelectedItems(1)en argument.
    '
    'Il faut répéter l'opération une seconde fois pour le document cible
    'On affiche à nouveau la boîte de dialogue pour que l'utilisateur donne
    'le nom du fichier cible
    With oDlg
        .AllowMultiSelect = False
        .Title = "Document cible avec les occurrences à remplacer"
        .Show 'Affichage de la boîte de dialogue. On demande à l'utilisateur
        '      qu'il désigne le fichier cible où seront effectués les remplacements
    End With
    '
    'L'objet oDlg va renvoyer le nom du fichier choisi par l'utilisateur.
    'Comme il n'y a qu'un seul fichier, nous récupérons le premier élément :
    'Choix du fichier : oDlg.SelectedItems(1)
    '
    'Ouverture du second document : Document cible avec les occurrences à remplacer
    Set oDocCible = Documents.Open(oDlg.SelectedItems(1))
    '
    '
    'Création de la boucle sur les éléments du tableau
    'Boucle sur les éléments du tableau qui seront utilisés pour la recherche et le remplacement.
    'On affecte le premier tableau du document source à la variable tableau pour ensuite faire une boucle sur les lignes du tableau.
    'Dans notre cas, c'est assez simple, la première colonne contient le mot à rechercher et la seconde, le mot de remplacement.
    '
    'Affectation de la table
    Set oTbl = oDocSource.Tables(1) 'On affecte le tableau du document source à la
                                    'variable oTbl pour ensuite faire une boucle sur les
                                    'lignes du tableau
    'Boucle sur les cellules de la table
    For Each oRow In oTbl.Rows 'Pour chaque ligne des lignes du tableau...
            oDocCible.Select 'Sélection du document cible
                Selection.HomeKey unit:=wdStory 'La recherche démarre au début du document
    'Dans cette boucle, nous utilisons directement le résultat dans notre fonction de recherche et remplacement.
                With Selection.Find
    '                .ClearFormatting 'Ne pas tenir compte des formats dans le remplacement
    				'  Ligne neutralisée afin de ne pas agir sur le format exposant lors du remplacement
                    .Forward = True
                    .Text = NetText(oRow.Cells(1).Range.Text) 'Utilisation de la fonction de nettoyage
                    .Replacement.Text = NetText(oRow.Cells(2).Range.Text) 'Utilisation de la fonction de nettoyage
    '                .Replacement.ClearFormatting 'Remise à zéro des paramètres de format de la fenêtre rechercher remplacer
    				'  Ligne neutralisée afin de ne pas agir sur le format exposant lors du remplacement
                    .Execute Replace:=wdReplaceAll 'Exécution de remplacer tout
                End With
    '
    Next oRow 'La boucle continue le traitement sur la ligne suivante
    'Libération des objets
    Set oDlg = Nothing
    Set oTbl = Nothing
    oDocSource.Close savechanges:=wdDoNotSaveChanges 'Fermeture du fichier du tableau sans enregistrer
    Set oDocSource = Nothing
    End Sub

    Cette macro ne donne aucun résultat. J'ai tenté plusieurs petites modifications, mais cela ne donne rien : Les occurrences "Melle" et "Mgr" ne sont pas transformées en "Melle" et "Mgr". Que faut-il corriger ? Merci pour ton attention.
    Fichiers attachés Fichiers attachés

  4. #4
    Nouveau membre du Club
    Homme Profil pro
    Archiviste d'association
    Inscrit en
    Juillet 2017
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : France, Loir et Cher (Centre)

    Informations professionnelles :
    Activité : Archiviste d'association
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2017
    Messages : 12
    Points : 29
    Points
    29
    Par défaut
    J'ai peut-être trouvé une autre solution VBA; je travaille dessus actuellement.
    À bientôt

  5. #5
    Nouveau membre du Club
    Homme Profil pro
    Archiviste d'association
    Inscrit en
    Juillet 2017
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : France, Loir et Cher (Centre)

    Informations professionnelles :
    Activité : Archiviste d'association
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2017
    Messages : 12
    Points : 29
    Points
    29
    Par défaut
    Citation Envoyé par La_Régie Voir le message
    J'ai peut-être trouvé une autre solution VBA; je travaille dessus actuellement.
    À bientôt
    Ça y est, je crois que j'ai quelque chose qui marche. N'étant pas expert en VBA, il y aurait sans doute des manières plus propres d'écrire du code, et je suis preneur de solutions plus élégantes, avec si possible les commentaires pour mieux comprendre.
    En attendant, voici ce sur quoi j'ai travaillé :

    Public Const RespectCasseOui As Boolean = True
    Public Const MotCompletOui As Boolean = True
    Public Const CaracGeneriqueOui As Boolean = True
    Public Const RespectCasseNon As Boolean = False
    Public Const MotCompletNon As Boolean = False
    Public Const CaracGeneriqueNon As Boolean = False
    '
    Sub TraitementExposants()
    '-------------------------------
    ' Remplacement des espaces par espaces insécables et première identification des exposants
    Call RpltChaineCar("Mme ", "Mme^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mmes ", "Mmes^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mlle ", "Mlle^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mlles ", "Mlles^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("M. ", "M.^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mgr ", "Mgr^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mgrs ", "Mgrs^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("MM. ", "MM.^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mme de ", "Mme^sde^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon) 'Cas des noms à particule
    Call RpltChaineCar("Mlle de ", "Mlle^sde^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon) 'Cas des noms à particule
    Call RpltChaineCar("M. de ", "M.^sde^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon) 'Cas des noms à particule
    Call RpltChaineCar("Mr ", "M.^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Mr de ", "M.^sde^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon) 'Cas des noms à particule
    Call RpltChaineCar("Mrs ", "Mme^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Dr ", "Dr^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon)
    Call RpltChaineCar("Dr. ", "Dr^s", RespectCasseOui, MotCompletOui, CaracGeneriqueNon) '"Dr." n'esty pas censé exister, mais remplacé par "Dr"
    'Les remplacements suivants utilisent les caractères génériques
    ' Ajout insécable après "Mgr Xxx"
    Call RpltChaineCar("(<Mgr) ([A-Z])", "\1^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<Mgrs) ([A-Z])", "\1^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable pour "Me Xxx"
    Call RpltChaineCar("(<Me) ([A-Z])", "\1^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable pour "Duc de Xxx"
    Call RpltChaineCar("(<Duc) (de) ([A-Z])", "\1^s\2^s\3", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable pour "Marquis de Xxx" et contraction pour exposant
    Call RpltChaineCar("(<Marquis) (de) ([A-Z])", "Mis^s\2^s\3", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable pour "Comte de Xxx" et contraction pour exposant
    Call RpltChaineCar("(<Comte) (de) ([A-Z])", "Cte^s\2^s\3", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable après "Maréchal Xxx" et contraction pour exposant
    Call RpltChaineCar("(Maréchal) ([A-Z])", "Mal^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable après "Général Xxx" et contraction pour exposant
    Call RpltChaineCar("(Général) ([A-Z])", "Gal^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable après "Colonel Xxx" et contraction pour exposant
    Call RpltChaineCar("(Colonel) ([A-Z])", "Cel^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    ' Ajout insécable après "Capitaine Xxx" et contraction pour exposant
    Call RpltChaineCar("(Capitaine) ([A-Z])", "Cne^s\2", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    '
    'Contraction de certains nombre ordinaux pour exposant
    'Les remplacements suivants utilisent les caractères génériques
    'Chiffres modernes - Remplacement par contraction
    Call RpltChaineCar("([1])ières", "\1res", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])ieres", "\1res", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])ière", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])iere", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])ères", "\1res", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])ère", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])iers", "\1ers", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([1])ier", "\1er", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([2])ndes", "\1des", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([2])nde", "\1de", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([2])nds", "\1ds", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([2])nd", "\1d", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])ièmes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])èmes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])ième", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])ème", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])emes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("([0-9])eme", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    'Chiffres romains - Remplacement par contraction
    Call RpltChaineCar("(<[I])ières", "\1res", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])ière", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])iere", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])ères", "\1res", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])ère", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])ere", "\1re", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])iers", "\1ers", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[I])ier", "\1er", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)iemes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)ièmes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)ieme", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)ième", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)emes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)èmes", "\1es", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)eme", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)
    Call RpltChaineCar("(<[IVX]@)ème", "\1e", RespectCasseNon, MotCompletNon, CaracGeneriqueOui)

    '
    ' Traitement des exposants identification des exposant par bornage de tags à leurs extrémités
    ' Utilisation de caractères génériques
    ' Le troisième argument seulement peut être vide
    Call PrepaExpo("<M", "me>", "")
    Call PrepaExpo("<M", "mes>", "")
    Call PrepaExpo("<M", "lle>", "")
    Call PrepaExpo("<M", "lles", "")
    ' Call PrepaExpo("<M", "r", "^s") ' "Mr." ne doit pas être mis en exposant, mais doit être remplacé par "M."
    ' Call PrepaExpo("<M", "rs", "^s") ' "Mrs" ne doit pas être mis en exposant, mais doit être remplacé par "Mme"
    Call PrepaExpo("<M", "gr>", "^s")
    Call PrepaExpo("<M", "grs>", "^s")
    Call PrepaExpo("<M", "e>", "^s") 'Me (Maître)
    Call PrepaExpo("<D", "r", "^s") ' Dr.
    Call PrepaExpo("<M", "is>", "^s") 'Marquis
    Call PrepaExpo("<C", "te>", "^s") 'Comte
    Call PrepaExpo("<M", "al>", "^s") 'Maréchal
    Call PrepaExpo("<G", "al>", "^s") 'Général
    Call PrepaExpo("<C", "el>", "^s") 'Colonel
    Call PrepaExpo("<C", "ne>", "^s") 'Capitaine
    Call PrepaExpo("<[I]", "er>", "") '"<[I]" : Commençant par "I" - "er>" : Se terminant par "er"
    Call PrepaExpo("<[IVX]@", "e>", "") ' Siècle - "<[IVX]@" : Commençant par l'un de ces trois caractères - "e>" : Se terminant par "e"
    Call PrepaExpo("<[1]", "er>", "")
    Call PrepaExpo("<[1]", "ers>", "")
    Call PrepaExpo("<[1]", "re>", "")
    Call PrepaExpo("<[1]", "res>", "")
    Call PrepaExpo("<[2]", "d>", "")
    Call PrepaExpo("<[2]", "de>", "")
    Call PrepaExpo("<[2]", "ds>", "")
    Call PrepaExpo("<[2]", "des>", "")
    Call PrepaExpo("[0-9]", "e>", "")
    ' Call PrepaExpo("[0-9]", "ème>", "") 'N'est pas censé exister, les occurrences "ème>" ayant été remplécées par "e>"
    ' Call PrepaExpo("[0-9]", "ième>", "")'N'est pas censé exister, les occurrences "ième>" ayant été remplécées par "e>"
    ' Call PrepaExpo("<[1I]", "ière>", "")'N'est pas censé exister, les occurrences "ière>" ayant été remplacées par "re>"
    ' Call PrepaExpo("<[1I]", "ières>", "") 'N'est pas censé exister, les occurrences "ières>" ayant été remplacées par "res>"
    ' On met en exposant tous les tags marqués
    DetagagExpo
    End Sub
    Private Sub RpltChaineCar(Cherchee As String, Remplacee As String, RespectCasse As Boolean, MotComplet As Boolean, CaracGenerique As Boolean)
    ' Cette maccro effectue des remplacements sur chaînes de caractères
    'Liste des arguments de la macro :
    ' Cherchee pour .Text
    ' Remplacee pour .Replacement.Text
    ' RespectCasse pour .MatchCase
    ' MotComplet pour .MatchWholeWord
    ' CaracGenerique pour .MatchWildcards
    ' Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = Cherchee
    .Replacement.Text = Remplacee
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = RespectCasse
    .MatchWholeWord = MotComplet
    #If Mac Then
    #Else
    .MatchKashida = False 'Espace kachidé : Concerne l'agencement du texteDéfinit le taux d'expansion kachidé pour l'expansion d'espace
    'lors de la justification de lignes de texte dans l'objet. Cette propriété est
    'utilisée pour les systèmes d'écriture arabe
    'La valeur True si recherche mettent en correspondance le texte des signes kachidés
    'dans un document en langue arabe. En lecture/écriture booléen.
    .MatchDiacritics = False 'Si False, ne prend pas en compte les signes diacritiques dans la rechertche.
    'Exemples de signes diacritiques : les accents, le tréma et la cédille
    .MatchAlefHamza = False ' Il semble que cela désigne des caractères arabes
    .MatchControl = False
    #End If
    .MatchWildcards = CaracGenerique
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End Sub
    Private Sub PrepaExpo(Prefixe As String, Italique As String, Suffixe As String)
    ' Cette macro marque la chaine de caractères centrale en exposant (ajout de tag "²TAGUEDEB²" et "²TAGUEFIN²" )
    ' Seul le 3e argument peut être vide. Liste des arguments de la macro :
    ' Prefixe
    ' Italique
    ' Suffixe
    '
    Dim vRecherche As String
    Dim vRemplace As String
    '
    If Suffixe <> "" Then
    vRecherche = "(" & Prefixe & ")(" & Italique & ")(" & Suffixe & ")"
    vRemplace = "\1²TAGUEDEB²\2²TAGUEFIN²\3"
    Else
    vRecherche = "(" & Prefixe & ")(" & Italique & ")"
    vRemplace = "\1²TAGUEDEB²\2²TAGUEFIN²"
    End If
    If Italique <> "" Then
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = vRecherche
    .Replacement.Text = vRemplace
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = True
    .MatchWholeWord = True
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End If
    End Sub
    Private Sub DetagagExpo()
    'Cette macro procède au détagage des exposants :
    'Retrait des tags à chaque extrémités des exposants
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
    .Superscript = True
    .Subscript = False
    End With
    With Selection.Find
    .Text = "²TAGUEDEB²(*)²TAGUEFIN²"
    .Replacement.Text = "\1"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End Sub

    Merci par avance de vos commentaires et améliorations éventuelles

Discussions similaires

  1. Réponses: 2
    Dernier message: 14/09/2006, 14h24
  2. Réponses: 10
    Dernier message: 02/08/2006, 15h32
  3. Modifier dynamiquement TOUS les URL d'une page
    Par Torpedox dans le forum Langage
    Réponses: 2
    Dernier message: 06/04/2006, 05h21
  4. Réponses: 14
    Dernier message: 17/10/2005, 09h41
  5. Ouvrir automatiquement tous les fch. texte d'un repertoire
    Par metalimad dans le forum VB 6 et antérieur
    Réponses: 5
    Dernier message: 18/02/2005, 14h47

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