Facture sur plusieurs pages

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Clic en dehors du tableau pour effacer les lignes coloriées
Range("A20:H" & Range("H65535").End(xlUp).Row).Interior.Pattern = xlNone
'Pour la partie désignation
If Not Intersect(Target, Range("A20:B38")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If
If Not Intersect(Target, Range("C20:E38")) Is Nothing And Target.Count = 4 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
If Len(Cells(Target.Row, 3)) > 75 Then
If Cells(Target.Row, 3).RowHeight = 15 Then testhauteur = 1
Cells(Target.Row, 3).RowHeight = 30
Else
If Cells(Target.Row, 3).RowHeight = 30 Then testhauteur = -1
Cells(Target.Row, 3).RowHeight = 15
End If
If testhauteur = 1 Then
For ligne = 38 To 20 Step -1
If Cells(ligne, 1).RowHeight > 0 And Cells(ligne, 1).Value = "" And compte = 0 Then
Cells(ligne, 1).RowHeight = 0
compte = 1
End If
Next ligne
If ligne = 0 Then MsgBox "La facture dépasse 1 page"
End If
If testhauteur = -1 Then
For ligne = 38 To 20 Step -1
If Cells(ligne, 1).RowHeight = 0 And compte = 0 Then
Cells(ligne, 1).RowHeight = 15
compte = 1
End If
Next ligne
End If
End If
If Not Intersect(Target, Range("F20:H38")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or annul = 1 Then annul = 0: Exit Sub
'Mettre en majuscule la première lettre
If Not Intersect(Target, Range("C20:E38")) Is Nothing Then annul = 1: Target = UCase(Left(Target, 1)) & Mid(Target, 2): Exit Sub
annul = 0
End Sub

Cliquez pour agrandir...

Private Sub TModifier_Click()
ActiveSheet.Unprotect
Range("G42") = "Réserve de " & TextBox1 & " %"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True
Me.Hide
End Sub

Cliquez pour agrandir...