Vba excel 97 à 2003 - concaténation

Question

Bonjour,

soit un tableau excel, avec par exemple trois cellules contenant du texte mis en forme
par exemble  A1, A2, A3

c'est à dire qu'un ou plusieures mots dans le texte de la cellule peuvent être en gras et en rouge et sous une certaine police, et le reste du texte de la police en normale et noir.

Je souhaite par macro retrouver mettre par exemple en cellule B1 le contenu concaténé de chacune des cellules A1,A2, et A3 en conservant la mise en forme du texte de chacune.

Comment faire ?

Je sais bien récupérer le contenu avec la propriété Value, mais je n'arrive pas à récupérer et concaténer les contenus avec leur mise en forme.

Merci beaucoup

santiago69 · Answer

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

eriiic · Answer

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

Vba excel 97 à 2003 - concaténation

2 réponses

Votre réponse

Newsletters