Concatener : format d'une partie du texte

nenex

XLDnaute Junior
Slt

Voulant mettre en forme apres avoir regrouper 2 colonne en 1, j'ai trouver comment le faire en VBA sur ce post. Voici le code :
Code:
Sub ConcaténerEtMiseEnForme()
' Macro réalisé par Excel-lent --> temps = 1"50
tps = Timer
Dim Ligne As Long
Dim ch As String

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For Ligne = 1 To [A65536].End(xlUp).Row
    ' Effacement de la colonne C
    Range("C" & Ligne).Clear
    ' CONCATENER : écrire dans la colonne C -> contenu colonne A + contenu colonne B
    Range("C" & Ligne) = Range("A" & Ligne) & " (" & Range("B" & Ligne) & ")"
    ' Recopie : la couleur de la police
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.ColorIndex = Range("A" & Ligne).Font.ColorIndex
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.ColorIndex = Range("B" & Ligne).Font.ColorIndex
    ' Recopie : la taille de la police
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Size = Range("A" & Ligne).Font.Size
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Size = Range("B" & Ligne).Font.Size
    ' Recopie : gras / non gras
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Bold = Range("A" & Ligne).Font.Bold
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Bold = Range("B" & Ligne).Font.Bold
    ' Recopie : italique / non italique
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Italic = Range("A" & Ligne).Font.Italic
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Italic = Range("B" & Ligne).Font.Italic
    ' Recopie : souligné / non souligné (+ type de soulignement : simple / double / ...)
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Underline = Range("A" & Ligne).Font.Underline
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Underline = Range("B" & Ligne).Font.Underline

Next Ligne

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox Timer - tps
End Sub


Sub Avec_le_With()

' Macro réalisé par Excel-lent et modifié par Soenda    --> 0"44

' Utilisation du With/End With plus lisible et plus efficace
' Utilisation de 2 variables afin d'éviter les appels de fonction chronophages
' Suppression de Clear (inutile car le contenu de la cellule va être écrasé)
' Ajout de Trim pour éviter les surprises (AIDE : sélectionner le mot Trim, et appuyer sur F1)

    tps = Timer
    
    Dim Ligne As Long
    Dim ColA As String
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
        For Ligne = 1 To [A65536].End(xlUp).Row
        
            With Range("C" & Ligne)             ' Avec la cellule C1  --> Quant ligne = 1
                                                
                ColA = "A" & Ligne              ' = "A1"
                
                .Value = Range(ColA) & " " & Range("B" & Ligne)     ' écrit dans la colonne C le contenu des colonnes A et B
                .Font.Italic = True                                 ' En italique
                .Font.Bold = False                                  ' Mais pas en gras
                
                With .Characters(1, Len(Trim(Range(ColA)))).Font    ' Avec la chaine de A1 copiée dans C1
                    .Bold = True                                    ' En gras
                    .Italic = False                                 ' Mais pas en italique
                End With
                
             End With
        
        Next Ligne
        
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox Timer - tps
    
End Sub

Je voudrais rajouter des parentheses (mes rajout en rouge) :
Range("C" & Ligne) = Range("A" & Ligne) & " (" & Range("B" & Ligne)&")"

Mais avec mes rajouts, la lettre se trouvant a cote de la parenthese qui se ferme n'est pas en italique.

Je savais pas si je pouvais deterrer le post, alors j'en cree un nouveau :p .

Merci pour votre aide.
 

CHALET53

XLDnaute Barbatruc
Re : Concatener : format d'une partie du texte

bonjour,

Peut-être en ajustant la longueur dans cette instruction :

Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne)) + 1).Font.Italic = Range("B" & Ligne).Font.Italic

tu peux y aller par tatonnement
 

Discussions similaires

Réponses
12
Affichages
580

Statistiques des forums

Discussions
312 329
Messages
2 087 329
Membres
103 517
dernier inscrit
hbenaoun63