1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Sub MettreEnGrasLeNumeroDansLaCellule()
Dim NbChr10 As Integer
Dim J As Integer
Dim PositionPremierCaractere As Integer
Dim PositionDernierCaractere As Integer
Dim ShAModifier As Worksheet
Dim AireAModifier As Range
Dim CelluleAModifier As Range
Dim DerniereLigneTableau As Long
Dim ColonneAModifier As Long
Dim LigneDeTitre As Long
Set ShAModifier = Sheets("Feuil1")
LigneDeTitre = 1
ColonneAModifier = 1
DerniereLigneTableau = ShAModifier.Cells(ShAModifier.Rows.Count, ColonneAModifier).End(xlUp).Row
With ShAModifier
Set AireAModifier = .Range(.Cells(LigneDeTitre + 1, ColonneAModifier), .Cells(DerniereLigneTableau, ColonneAModifier))
For Each CelluleAModifier In AireAModifier
NbChr10 = 0
PositionPremierCaractere = 0
PositionDernierCaractere = 0
If CelluleAModifier <> "" Then
For J = 1 To Len(CelluleAModifier)
If Mid(CelluleAModifier, J, 1) = Chr(10) Then
NbChr10 = NbChr10 + 1
If NbChr10 = 2 Then PositionPremierCaractere = J + 1
If NbChr10 = 3 Then PositionDernierCaractere = J - 1
End If
Next J
' Au cas où il n'y aurait pas de date
If NbChr10 = 2 And Len(CelluleAModifier) > PositionPremierCaractere Then PositionDernierCaractere = Len(CelluleAModifier)
' MsgBox NbChr10 & Chr(10) & PositionPremierCaractere & Chr(10) & PositionDernierCaractere
If PositionPremierCaractere > 0 And PositionDernierCaractere > 0 Then
With CelluleAModifier.Characters(Start:=PositionPremierCaractere, Length:=PositionDernierCaractere - PositionPremierCaractere + 1).Font
.Name = "Verdana"
.Size = 14
.Bold = True
End With
End If
End If
Next CelluleAModifier
End With
Set AireAModifier = Nothing
Set ShAModifier = Nothing
End Sub |
Partager