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
|
Option Explicit
Sub AnglaisFrancais()
Application.Run MacroName:="blancs"
Application.Run MacroName:="UKFR01"
Application.Run MacroName:="UKFR02"
End Sub
Sub FrancaisAnglais()
Application.Run MacroName:="blancs"
Application.Run MacroName:="FRUK01"
Application.Run MacroName:="FRUK02"
End Sub
Sub UKFR01()
Dim t As Table
Dim c As Cell
Dim tb
For Each t In ActiveDocument.Tables
For Each c In t.Range.Cells
tb = Split(c.Range.Text, Chr(13) & Chr(7)) 'les cellules des tableaux word finissent par les caractéres 13 et 7..
c.Range.Text = Replace(tb(0), ",", " ")
Next
Next
End Sub
Sub UKFR02()
Dim t As Table
Dim c As Cell
Dim tb
For Each t In ActiveDocument.Tables
For Each c In t.Range.Cells
tb = Split(c.Range.Text, Chr(13) & Chr(7)) 'les cellules des tableaux word finissent par les caractéres 13 et 7..
c.Range.Text = Replace(tb(0), ".", ",")
Next
Next
End Sub
Sub FRUK01()
Dim t As Table
Dim c As Cell
Dim tb
For Each t In ActiveDocument.Tables
For Each c In t.Range.Cells
tb = Split(c.Range.Text, Chr(13) & Chr(7)) 'les cellules des tableaux word finissent par les caractéres 13 et 7..
c.Range.Text = Replace(tb(0), ",", ".")
Next
Next
End Sub
Sub FRUK02()
Dim t As Table
Dim c As Cell
Dim tb
For Each t In ActiveDocument.Tables
For Each c In t.Range.Cells
tb = Split(c.Range.Text, Chr(13) & Chr(7)) 'les cellules des tableaux word finissent par les caractéres 13 et 7..
c.Range.Text = Replace(tb(0), " ", ",")
Next
Next
End Sub
' ********** Ceci ne fonctionne pas ***********
'Sub FRUK03()
' Dim t As Table
' Dim c As Cell
' Dim tb
' For Each t In ActiveDocument.Tables
' For Each c In t.Range.Cells
' tb = Split(c.Range.Text, Chr(13) & Chr(7)) 'les cellules des tableaux word finissent par les caractéres 13 et 7..
' c.Range.Text = Replace(tb(0), "^s", ",")
' Next
' Next
'End Sub
Sub blancs()
' Macro pour supprimmer tous les espaces blancs inutiles et en surnombre
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^w"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub |
Partager