Macro word , Multiplication par un coefficient de valeurs en euros [Résolu]

[brunodim]

Bonjour,

Je voudrais faire une macro pour un fichier word qui contient des grilles de tarifs.

La macro consisterait à multiplier les tarifs par un coeffiscient (1,3).
Les tarifs sont au format : 125 € et se trouvent dans des tableaux.
Il faudrait donc que la macro recherche les valeurs numériques dans les tableaux du document qui sont suivi du caractère " €" et qu'elle les multiplie par 1.3 .

Il ya beaucoup de tarifs et ce serait trés laborieux de le faire manuellement.

Problème : je n'y connais rien en macro et en vb.

Quelqun pourrait-t-il me guider ?

Merci

[Heureux-oli]

Il y a d'autres informations qui peuvent être utiles.

Les prix sont-ils toujours dans le même colonne ?

Combien de tableaux ?

[brunodim]

Bonjour,

J'essai de créer une macro sous word qui consiste à multiplier par un coefficient toutes les valeurs en euro du document.

Il s'agit d'une grille de tarifs.

La macro consiste donc à repérer toutes les chaines formées d'un nombre et suivies du signe €. Ensuite il faut multiplier ce nombre par le coefficient (1.3) et remplacer la valeur.

Je pense être arrivé pret du but mais je patoge. Mon code est le suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Coeff() 
 
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[0-9]{1;} €"
        .Replacement.Text = CStr(CDbl(Split(.Text, " ")(0)) * 1.3) + " €"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
End Sub

L'exécution de la macro génère un message d'erreur (type incompatible,) après divers essais, j'ai compris que l'erreur est du au fait que j'applique le coefficient à la valeur "[0-9]{1;} €" au lieu de l'appliquer à la valeur réelle des éléments trouvés.

Je ne sais pas comment accéder au valeurs réelles des montants trouvés pour appliquer le coefficient.

Je ne suis pas sur d'avoir été très clair.

Merci pour votre aide

[Heureux-oli]

Pourquoi ne réponds tu pas au post précédent ?

[brunodim]

Pardon, j'avais pas vu qu'on m'y avait répondu.

[brunodim]

IL y'a des dizaines de tableaux et beaucoup de colonnes.
Le mieux est de répérer les valeurs en euros dans tout le document peut importes ou elles se trouvent.

J'ai fait le code suivant mais l'exécution de la macro génère une erreuer (types incompatibles) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Coeff() 
 
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[0-9]{1;} €"
        .Replacement.Text = CStr(CDbl(Split(.Text, " ")(0)) * 1.3) + " €"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
End Sub

Il semble que cette erreur soit du au fait que le script applique le coefficient à la valeur "[0-9]{1;} €" au lieu de prendre les valeurs réelles trouvées.

Je ne sais pas comment accéder à ces valeurs.

Merci pour votre réponse

[Heureux-oli]

Ce que tu va devoir faire, c'est pour chaque tableau de ton document parcourir les cellules.
Pour chaque tableau, compter le nombre de lignes et de colonnes.

Dans chaque cellule, vérifier si le sigle € est présent et en noter la position.
Lorsque la position est repérée, récupérer le nombre, le multiplier et réinjecter la valeur dans le tableau avec le signe € en plus.

Qu'en penses-tu ?

[brunodim]

Merci, je vais essayer comme ça.

[Heureux-oli]

Pour parcourir les tables

Code :

1
2
3
4
Dim oTbl as Table
For Each oTbl in ActiveDocument.Tables
 
Next oTbl

Pour compter le nombre de lignes ou de colonnes

Code :

1
2
Dim iR as Integer
iR = oTbl.Rows.Count

Pour les colonnes, on utilise Columns.

Pour les cellules, il faut adresser les cellules

Code :

1
2
3
4
For iRc = 1 To iR
    For iCc = 1 To iC
       stTemp = oTbl.Cell(iRc,ICc).Range.Text
       iN = Instr(stTemp,"€")

Ce sont des idées.

[brunodim]

Bonjour

Merci pour votre aide
J'ai fait différement, cela fonctionne sans parcourir chacun des tableaux, mais le script n'est pas optimal et le temp d'exécution est assez long car il y'a plus de 1000 prix.

Voici le code :

Code :

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
Sub test()
'
' test Macro
' Macro enregistrée le 16/01/2008 par Bruno Di Miceli
'
    Selection.WholeStory
    Set reg = New VBScript_RegExp_55.RegExp
    reg.Global = True
    reg.Pattern = "([0-9]+) €"
    ' MsgBox reg.Replace("coucou 25 € toto", "$MUL($1 * 1.8)")
    ' MsgBox Selection.Text
    Set Matches = reg.Execute(Selection.Text)
    For Each Match In Matches
        'MsgBox Match.SubMatches(0) * 1.8
        'Coeff (Match.SubMatches(0), Match.SubMatches(0) * 1.8)
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            '.Text = "[0-9]{1;} €"
            .Text = "<" + Match.SubMatches(0) + " €"
            '.Replacement.Text = CStr(CDbl(Split("^&", " ")(0)) * 1.8) + " €"
            .Replacement.Text = CStr(CInt(Match.SubMatches(0) * 1.8 * 1.196)) + ",00 €"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        MsgBox CStr(Match.SubMatches(0)) + " € => " + CStr(CInt(Match.SubMatches(0) * 1.8)) + ",00 €"
    Next Match
 
    'MsgBox Selection.Text
 
End Sub

Encore merci à bientot