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 :
Je voudrais rajouter des parentheses (mes rajout en rouge) :
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 .
Merci pour votre aide.
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 .
Merci pour votre aide.