Option Explicit
Sub HauteurLigneMergeArea(MergedZone As Range)
Dim Zone1Cel As Range
Dim Ind As Long
Dim LargeurTotale As Single
' Désactiver les événements
Application.EnableEvents = False
' Définir la cellule qui va contenir le texte
Set Zone1Cel = ActiveSheet.Range("Z" & MergedZone.Row)
'Déterminer la largeur totale de la zone fusionnée
For Ind = 1 To MergedZone.Columns.Count
LargeurTotale = LargeurTotale + MergedZone.Columns(Ind).ColumnWidth
Next
' Appliquer la largeur totale à la colonne 1
Zone1Cel.ColumnWidth = LargeurTotale - 1
' Inscrire dedans le texte
Zone1Cel.Value = MergedZone.Cells(1, 1).Value
' Appliquer le retour à la ligne de la cellule unique
' et son ajustement automatique
With Zone1Cel
.WrapText = False
.WrapText = True
.Rows.AutoFit
End With
' Forcer la hauteur de ligne
MergedZone.RowHeight = Zone1Cel.RowHeight
' Effacer le contenu de la cellule unique
Zone1Cel.Clear
' Réactiver les événements
Application.EnableEvents = True
End Sub
Sub MettreEnForme()
Dim cell As Range
Dim searchText As String
Dim startPos As Integer
Dim numberPart As String
Dim Target As Range
' Définir le texte à rechercher
searchText = "Article "
' Parcourir chaque cellule dans la plage A1:A18
For Each cell In Range("A1:A18")
' Vérifier si la cellule commence par le texte recherché
If Left(cell.Value, Len(searchText)) = searchText Then
' Trouver la position du premier espace après "Article +"
startPos = Len(searchText) + 1
Do While Mid(cell.Value, startPos, 1) <> " " And startPos <= Len(cell.Value)
startPos = startPos + 1
Loop
' Extraire le numéro après "Article +"
numberPart = Mid(cell.Value, Len(searchText) + 1, startPos - Len(searchText) - 1)
' Mettre "Article +N" en gras
cell.Characters(Start:=1, Length:=Len(searchText) + Len(numberPart)).Font.Bold = True
' Si la cellule a du texte après "Article +N", le laisser en normal (non gras)
If Len(cell.Value) > Len(searchText) + Len(numberPart) Then
cell.Characters(Start:=Len(searchText) + Len(numberPart) + 1).Font.Bold = False
End If
' Ajuster la largeur de la cellule
cell.Rows.AutoFit
End If
Next cell
' Ajuster la hauteur des lignes des cellules fusionnées dans la plage A1:A15
On Error Resume Next
For Each cell In ActiveSheet.Range("A1:A15")
Set Target = cell
If Not Target Is Nothing Then Call HauteurLigneMergeArea(Target.MergeArea)
Next cell
On Error GoTo 0
End Sub
