Concaténer avec couleur

[Jaquot]

Bonsoir le forum
Je voudrais concaténer des cellules et conserver la couleur de la police .
Pour cela étant néophyte en vba j'ai bidouillé une macro mais je n'arrive pas à la creer en fonction personnaliséé.
Si une ame charitable passe par là,soyez indulgent !!
Merci d'avance

ps:je n'arive pas à envoyer en pièce jointe voici le code
Sub ConcaténerAvecCouleur()

Range("b7").Select
LongueurTexte = Len(Range("B7"))
COULEUR = Selection.Font.ColorIndex
Range("d7").Select
ActiveCell.FormulaR1C1 = "=+RC[-2]&RC[-1]"
Range("c7").Select
LongueurTexte2 = Len(Range("c7"))
COULEUR1 = Selection.Font.ColorIndex
Range("d7").Select
ActiveCell.FormulaR1C1 = (Range("d7").Value)
With ActiveCell.Characters(Start:=1, Length:=LongueurTexte).Font
.ColorIndex = COULEUR
End With
With ActiveCell.Characters(Start:=LongueurTexte + 1, Length:=LongueurTexte2).Font
.ColorIndex = COULEUR1
End With
End Sub

 

[Zon]

Salut,

Voici un fucntion de ce que tu demandes tu pêux l'appeler dpuis une boucle dasn une autre procédure

Private Function ConcatenerAvecCouleur(C1 As Range, C2 As Range, C3 As Range)
Dim Couleur1&, Couleur2&, Text1$, Text2$
With C1
LongueurTexte = Len(.Value)
Couleur = .Font.ColorIndex
Text1 = .Text
End With
With C2
LongueurTexte2 = Len(.Value)
Couleur2 = .Font.ColorIndex
Text2 = .Text
End With
With C3
.Value = Text1 & Text2
With .Characters(Start:=1, Length:=LongueurTexte).Font
.ColorIndex = Couleur
End With
With .Characters(Start:=LongueurTexte + 1, Length:=LongueurTexte2).Font
.ColorIndex = Couleur1
End With
End With
End Function

Sub Princ()

ConcaténerAvecCouleur [B7], [C7], [D8]

End Sub

A+++

 

[jon]

bonjour

au fait il est simple de passer une sélection étendue à une fonction, mais si quelqu'un sait comment lui passer une sélection multiple, je suis preneur.

cela pourrait améliorer ta fonction, Zon.

ciao
stephane

 

[Jaquot]

Merci Zon pour ton aide,mais je n'arrive pas à la faire fonctionner,lorsque je fait insertion fonction personnalisé je ne la trouve pas.
Désolé je débute

 

[Zon]

Salut,

Normal que tu ne puisses pas la voir puisque je l'ai mise en Private. En essayant d'en faire une fonction perso je me retrouve avec des références circulaires, les formules c'est pas mon truc.

Tu colles cela dans un module standard

Sub Princ()
Dim I&
For I = 1 To [A65536].End(xlUp).Row
ConcatenerAvecCouleur Range("A" & I), Range("B" & I), Range("c" & I)
Next I
End Sub

Sub ConcatenerAvecCouleur(C1 As Range, C2 As Range, C3 As Range)
With C3
.Value = C1.Text & C2.Text
With .Characters(1, Len(C1.Text)).Font
.ColorIndex = C1.Font.ColorIndex
End With
With .Characters(Len(C1.Text) + 1, Len(C2.Text)).Font
.ColorIndex = C2.Font.ColorIndex
End With
End With
End Sub

A+++

 

[Jaquot]

Bonsoir Zon et le forum
Un grand merci pour ton aide ,c'est OK