[XL-2003] concaténer sans perte de mise en forme [Résolu]

[pirot]

Bonjour,
je désire concaténer des cellules qui contiennent des otient caractères de mise en forme différents.
ex: A1 contient Bonjour Monsieur ,
A2 contient Madame et Mademoiselle
(dans cet exemple, Monsieur est en gras, madame en italique et mademoiselle dans une autre taille, mais cela peut varier bien sûr)

je veux mettre en A3 le contenu de A1 et A2, en conservant les mises en forme.
si je fais:

Code :

1
2
range("A1").copy
activesheet.paste destination:=range("A3")

cela me conserve la mise en forme de ce qui provient de A1
Mais ensuite, je ne sais pas comment ajouter le contenu de A2,
en gardant la mise en forme de ce que j'ajoute.
merci de votre aide
Pirot

[mercatog]

Bonjour
Une gymnastique

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
Sub Test()
 
With Worksheets("Feuil1")
    .Range("A3") = .Range("A1") & " " & .Range("A2")
    Formater .Range("A3"), .Range("A1"), 0
    Formater .Range("A3"), .Range("A2"), Len(.Range("A1")) + 1
End With
End Sub
 
Private Sub Formater(RngDest As Range, RngSce As Range, n As Integer)
Dim d As Integer, i As Integer
Dim Tb
 
Tb = Split(RngSce)
For i = 0 To UBound(Tb)
    d = d + 1
    With RngDest.Characters(d + n, d + n + Len(Tb(i))).Font
        .FontStyle = RngSce.Characters(d, 1).Font.FontStyle
        .Size = RngSce.Characters(d, 1).Font.Size
        .Color = RngSce.Characters(d, 1).Font.Color
        .Underline = RngSce.Characters(d, 1).Font.Underline
    End With
    d = d + Len(Tb(i))
Next i
End Sub

[pirot]

Bonsoir,
et merci à mercatog !
J'utilisais .characters pour ajouter la seconde chaîne,MAIS
je progressais caractère par caractère (length:=1).
=> temps de traitement très long
(il s'agit en fait de rassembler des lignes d'un catalogue
de 10 000 lignes)
@+
pirot