perte de format de cellule: comment éviter?

salut,

dans ta macro, remplace la ligne:
Range("E" & i).Value = Left(Range("E" & i).Value, L)


par ce bout de code:

Dim Lg
Dim tbl
ReDim tbl(L - 1, 9)
With Range("E" & i)
For Lg = 0 To L - 1
tbl(Lg, 0) = .Characters(Start:=Lg + 1, Length:=1).Font.Name
tbl(Lg, 1) = .Characters(Start:=Lg + 1,
Length:=1).Font.FontStyle
tbl(Lg, 2) = .Characters(Start:=Lg + 1, Length:=1).Font.Size
tbl(Lg, 3) = .Characters(Start:=Lg + 1,
Length:=1).Font.Strikethrough
tbl(Lg, 4) = .Characters(Start:=Lg + 1,
Length:=1).Font.Superscript
tbl(Lg, 5) = .Characters(Start:=Lg + 1,
Length:=1).Font.Subscript
tbl(Lg, 6) = .Characters(Start:=Lg + 1,
Length:=1).Font.OutlineFont
tbl(Lg, 7) = .Characters(Start:=Lg + 1, Length:=1).Font.Shadow
tbl(Lg, 8) = .Characters(Start:=Lg + 1,
Length:=1).Font.Underline
tbl(Lg, 9) = .Characters(Start:=Lg + 1,
Length:=1).Font.ColorIndex
Next
Range("E" & i).Value = Left(Range("E" & i).Value, L)
For Lg = 0 To L - 1
With .Characters(Start:=Lg + 1, Length:=1).Font
.Name = tbl(Lg, 0)
.FontStyle = tbl(Lg, 1)
.Size = tbl(Lg, 2)
.Strikethrough = tbl(Lg, 3)
.Superscript = tbl(Lg, 4)
.Subscript = tbl(Lg, 5)
.OutlineFont = tbl(Lg, 6)
.Shadow = tbl(Lg, 7)
.Underline = tbl(Lg, 8)
.ColorIndex = tbl(Lg, 9)
End With
Next
End With

--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"wissem.upe" <wissem.upe@free.fr> a écrit dans le message de news:
432c99a1$0$14580$626a14ce@news.free.fr...

bonsoir,
lorsque je mets cette ligne dans un module VBA avec par exemple i et
L=6 :

Range("E" & i).Value = Left(Range("E" & i).Value, L)

la cellule E12 perd sa mise en forme multiple
(au départ certaines lettres sont en gras d'autres pas, certaines en
police arial d'autres en Times) : tout est uniformisé: tout est en gras et
en arial.

Comment faire pour empêcher celà et conserver les différents formats?

merci
wissem
---------------
(en fait ma macro doit enlever tous les points en fin de cellule:
Sub sup1_points()
nl = InputBox("Combien de lignes à balayer ?", "enlevons les points en fin
de ligne", 1000)
For i = 1 To nl
c = Range("E" & i).Value
L = Len(c)
If L > 0 Then
p = Right(c, 1)
While p = "." Or Asc(p) = 133
L = L - 1
c = Left(c, L)
p = Right(c, 1)
Wend
Range("E" & i).Value = Left(Range("E" & i).Value, L)
End If
Next
End Sub
-------------
ou existe-il un moyne d'enlever tous les points autrement en conservant
les formats de caractères
----------------?

Bonsoir,
Très simplement: merci à Jean-François Aubert.
C'est parfait.
quel bonheur !
Wissem