Facture sur plusieurs pages

RONIBO

XLDnaute Impliqué
Bonjour le forum :)

Je possède d'un modèle de facture qui me permet aussi de faire des devis,

Actuellement je crée des factures sur plusieurs pages, (sur 2 voir 3 pages)

J'ai fait une répétition de lignes grâce à la mise en page-->Feuille, ce qui me permet de recopier l'entête de ma facture sur les autres page.

Mon premier problème est que lorsque j'insère des lignes, la deuxième page de ma facture se présente comme ça :

Page 1 :



Page 2 :



Je suis obligé d'insérer des lignes vides manuellement (sur la deuxième page) pour que ma facture se présente comme ceci :

Page 1 :



Page 2 :


Je voulais savoir si c'été possible d'insérer des lignes vide jusqu'à s'que les pages suivante de ma facture (2,3,4 etc.) s'étale sur la page entière. On peut automatisé ça avec un code?

Deuxième problème est qu'à partir ou j'ai des factures sur plusieurs pages, le code ci dessous ne fonctionne pas sur les nouvelle lignes que j'ai inséré.

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

Je pense que ce code est paramétré que pour une partie bien défini, c'est pour ça que ça ne marche pas des que j'insère des lignes.

J'ai le même problème pour la hauteur des lignes, dès que je dépasse les 75 caractères (dans la colonne désignation) la hauteur de la ligne passe automatiquement à "30", mais ne marche pas sur les lignes que j'insère.

Y'a t-il une solution à ça?

Troisième problème j'ai toujours le même problème mais cette fois ci avec l'USF "Réserve".

Voici le code qui se trouve dans l'USF

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

A partir du moment ou je modifie le taux il me le reporte toujours dans "G42", j''insère une ligne et hop il me décale tout :(

Quatrième problème concerne l'USF pour insérer ou supprimer des lignes

J'ai ces erreurs lorsque j'exécute l'USF
Selection.EntireRow.Insert

Selection.EntireRow.Delete


Je vous mets en fichier exemple.

Et merci d'avance aux personnes qui vont s'intéresser à mon problème :)

A Bientôt
 

Pièces jointes

  • Clients.xlsm
    63 KB · Affichages: 67
  • Clients.xlsm
    63 KB · Affichages: 66
  • Clients.xlsm
    63 KB · Affichages: 64
  • Exemple.xlsm
    186.3 KB · Affichages: 77
  • Exemple.xlsm
    186.3 KB · Affichages: 72
  • Exemple.xlsm
    186.3 KB · Affichages: 68
Dernière édition:

Discussions similaires

Réponses
1
Affichages
233

Membres actuellement en ligne

Statistiques des forums

Discussions
314 499
Messages
2 110 249
Membres
110 711
dernier inscrit
chmessi