Vba excel 97 à 2003 - concaténation

Je me suis deja penche sur le probleme. c'est une sacree galere.
enfin pas tant que ca puisqu'il y a l'objet

Cells(ligne, colonne).Characters(debut, longueur).Text

qui donne la valeur d'un extrait de la chaine contenu dans la cellule et l'objet

Cells(ligne, colonne).Characters(debut, longueur).Font

avec les proprietes FontStyle, Size, Color, Bold, Italic...
qui donne le format d'un extrait de la chaine contenu dans la cellule.

En fait, ce qui est chiant, c'est que je ne vois pas comment faire autrement que de prendre les caracteres un par un et de leur appliquer leur style propriete par propriete.

Bon courage
Santiago

Bonsoir,

voici une macro qui te récupère les attributs couleur, souligné, gras, italique sur les cellules d'origine d'une concaténation. Avec, au choix, écrasement de la formule ou écriture à un offset horizontal de ton choix.
En prime tu peux ajouter des retour à la ligne dans la concaténation avec l'ajout de &"vbLf" dans la concaténation.
Par contre, de mémoire je ne récupère pas la police ni sa taille, il faudra le rajouter...
http://www.cijoint.fr/cjlink.php?file=cj200810/cij0kyWaq0.xls

eric

Le code pour quand le lien sera périmé :

Sub RecupFormatCel()
    Dim c1 As Range, c2 As Range, dest As Range
    Dim i As Integer, long1 As Long, ptr1 As Long, offset1 As Long
    Dim formatCel As Variant
    Dim ListeRef As Variant
    Dim msg As String
    msg = "A quel offset (en colonnes) coller le résultat ?" & vbCrLf
    msg = msg & "(si offset = 0 la formule d'origine " & vbCrLf
    msg = msg & "sera remplacée par la chaine formatée)"
    offset1 = InputBox(msg, "Choix offset résultat", 1)

    For Each c1 In Selection
        f = c1.Formula
        If Left(f, 1) <> "=" Then 'formule ?
            MsgBox ("Erreur" & vbCrLf & "La cellule " & c1.Address & " ne contient pas de formule de concatenation")
            Exit Sub
        Else
            f = Mid(c1.Formula, 2) 'oui: eliminer =
        End If
        Set dest = c1.Offset(0, offset1) 'cellule de destination
        dest.Value = c1.Value
        ListeRef = Split(f, "&") ' découper la formule
        '
        ' remplacement des "vbLF" par vbLf
        While InStr(1, LCase(dest.Value), LF)
            pos = InStr(1, LCase(dest.Value), LF)
            dest = Left(dest.Value, pos - 1) & vbLf & Mid(dest.Value, pos + Len(LF))
        Wend

        ' récupération des formats
        ptr1 = 1
        For i = 0 To UBound(ListeRef)
            Set c2 = Range(ListeRef(i)) ' adresse de la chaine
            long1 = Len(c2.Value) ' longueur de la chaine
            If LCase(c2.Value) = LF Then
                ' traitement vbLF
                long1 = 1
            Else
                With c2.Font
                    formatCel = .FontStyle
                    dest.Characters(Start:=ptr1, Length:=long1).Font.FontStyle = formatCel
                    formatCel = .ColorIndex
                    dest.Characters(Start:=ptr1, Length:=long1).Font.ColorIndex = formatCel
                    formatCel = .Underline
                    dest.Characters(Start:=ptr1, Length:=long1).Font.Underline = formatCel

                End With
            End If
            ptr1 = ptr1 + long1
        Next i
    Next c1
End Sub

Modop: sélectionner les cellules avec concaténation et appeler la macro.
Offset=0 : écrasement de la formule de concaténation
Offset=1 : écriture 1 cellule à droite de la formule (à faire dans un 1er temps pour tester sans perdre la formule)

eric