Facture sur plusieurs pages
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.
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
Bonsoir,
Personne à une idée?
Bonjour
Le bout de macro qui se lance avec le bouton "Mise en page" devrait régler ton premier problème.
Quant aux autres...
Bonsoir le forum,
@gmb : Merci pour ce code, le principe est bon c'est à peut près s'que je veux
J'attends d'autre proposition pour les autres problèmes
a+
Bonsoir le forum,
Bonsoir GMB
J'essaye d'intégrer ton code dans mon fichier, mais je rencontre quelques problèmes de mise en forme
Voici la liste :
1 - Me manque les traits verticales
2 - Possibilité de fissionner les cellules de la colonne "Désignation"
3 - Une fois les cellules insérés, tout mes macro ne fonctionne plus.
Je te mets mon fichier avec la nouvelle version (si tu peux travailler avec celui la, ça serai sympa)
Merci encore
a+
Bonjour
Ronibo a écrit :
1 - Me manque les traits verticales
C'est curieux. Peut-être un problème de version ?
Ronibo a écrit :
Possibilité de fissionner les cellules de la colonne "Désignation"
Désolé mais je ne comprends pas : je ne fais pas dans le nucléaire. En clair, tu devrais te relire...
Ronibo a écrit :
Une fois les cellules insérés, tout mes macro ne fonctionne plus.
J'en suis désolé mais ne vois pas quoi y faire.
Ronibo a écrit :
Je te mets mon fichier avec la nouvelle version
Tu dis que tu l'as mis où ? Je ne trouve rien.
bonjour Ronibo, gmb et le forum
je pense que si tu lit les sujets similaires, qui sont en bas de ton fil, tu devrai trouvé parfois ce que tu cherche comme ce https://forum.excel-pratique.com/excel/liste-sur-plusieurs-colonnes-puis-plusieurs-pages-t22633.html qui est en tête de liste et qui correspond un peu a ce que tu veux Ronibo
bonne journée a tous
Pascal