Discussion :

[grisan29]

bonjour a vous tous
je voudrais que le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
With Sheets("facturation")
NewLig = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range("C" & NewLig).Value = TextBox1.Value ' designation 
.Range("I" & NewLig).Value = TextBox2.Value ' prix 
.Range("J" & NewLig).Value = TextBox3.Value ' unite 
.Range("K" & NewLig).Value = TextBox4.Value ' qte 
.Range("M" & NewLig).Value = .Range("K" & NewLig).Value * .Range("I" & NewLig).Value 
.Range("G" & NewLig).Value = IIf(Me.OptionButton5, 1, 2) 
.Range("H" & NewLig).Value = IIf(Me.OptionButton5, 0.055 * .Range("F" & NewLig).Value, "")
.Range("I" & NewLig).Value = IIf(Me.OptionButton6, 0.196 * .Range("F" & NewLig).Value, "") 
'.....
End With

puisse etre modifié afin que les textbox et option button inscrive leur donnée a partir de la ligne 19 soit
et cela toujours dans les mêmes colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
txtbox1 a b19. End(xlDown)
txtbox2 à i19. End(xlDown)
txtbox3 à j 19. End(xlDown)
txtbox 4 à k19. End(xlDown)

le choix des optionbutton en M19. End(xlDown)
option button5 tva 5.5 en O19. End(xlDown)
OptionButton6 tva 19.6 en P19. End(xlDown)

et ce jusque la ligne 30 environ et en ajoutant une lignes a chaque fois
voici un code qui le fait mais en appuyant sur un bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim a As Integer, lig As Integer
a = MsgBox("Voulez-vous ajouter un enregistrement ?", vbYesNo + vbQuestion, "Ajouter")
If a = vbYes Then
lig = Range("B19").End(xlDown)(1).Row
Range("B19").End(xlDown)(1).EntireRow.Insert
Range("C" & lig + 1).Copy Range("C" & lig)
Range("K" & lig + 1 & ":L" & lig + 1).Copy Range("K" & lig)
Range("O" & lig + 1 & ":P" & lig + 1).Copy Range("O" & lig)
Range("B19:M" & lig + 1).Sort Key1:=Range("B19"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If

puis faire un saut par dessus le pied de page pour recommencer en ligne 19 sur une autre feuille et repartir a la ligne 19 feuille suivante

merci par avance
bonne journée
Pascal

bonjour a vous tous

pour faire plus simple et par étape ,comment peut on faire commencer ce code pour écrire ses données sur la ligne 19 et ses suivantes
c'est un code fourni gracieusement par Mercatog

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim NewLig As Long
 
With Sheets("facturation")
   NewLig = .Cells(Rows.Count, 2).End(xlUp).Row + 1

merci a vous tous

Pascal

[Antoniom]

Hello,

Peut-être comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim NewLig As Long
 
With Sheets("facturation")
   NewLig = .Cells(19, 2).End(xlUp).Row + 1

Bonne journée, Antoniom.

[grisan29]

bonjour a vous et a antonium
ta solution est parfaite en modifiant .cells(19, 2) par .cells(19, 3) ????
je te joint le code complet pour t'en rendre compte,le code ne progresse pas d'une ligne a chaque choix de textbox mais remplace le contenu de la première selection

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub CommandButton2_Click()
Dim NewLig As Long
With Sheets("facturation")
NewLig = .Cells(19, 2).End(xlUp).Row + 1
.Range("C" & NewLig).Value = TextBox1.Value ' designation
.Range("I" & NewLig).Value = TextBox2.Value ' prix
.Range("J" & NewLig).Value = TextBox3.Value ' unite
.Range("K" & NewLig).Value = TextBox4.Value ' qte
.Range("L" & NewLig).Value = .Range("K" & NewLig).Value * .Range("I" & NewLig).Value
.Range("M" & NewLig).Value = IIf(Me.OptionButton5, 1, 2)
.Range("O" & NewLig).Value = IIf(Me.OptionButton5, 0.055 * .Range("L" & NewLig).Value, "")
.Range("P" & NewLig).Value = IIf(Me.OptionButton6, 0.196 * .Range("L" & NewLig).Value, "")
'.....
 
End With
 
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End Sub

merci pour tout et bon week end

Pascal

[zyhack]

Bonjour grisan29

le code de mercatog adapté pour n'écrire qu'a partir de la ligne 19

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
With Sheets("facturation")
'Chercher la premiere ligne vide
newlig = .Cells(Rows.Count, 3).End(xlUp).Row + 1
'si cette ligne est inférieure à 19 alors Newlig = 19
If newlig < 19 Then newlig = 19

[grisan29]

bonjour zyhack et merci

le code que tu m'as donné fonctionne mais pas a partir de la ligne 19 mais apres le bas de page car je pense que le code cherche la dernière ligne vide
je le reconnais je n'en avait rien dit
mais je peux joindre un exemple s'il le faut

bonn week end
Pascal

[zyhack]

Bonjour

Recherche de la première ligne vide avant le premier saut de page

variable à ajouter en début de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Dim Address1erHPB As String

code modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
With Sheets("facturation")
  'cherche la dernière ligne avant le premier saut de page
  If .HPageBreaks.Count > 0 Then Address1erHPB = .HPageBreaks(1).Location.Offset(-1, 0).Address
 
  'Chercher la premiere ligne vide
  newlig = .Cells(Range(Address1erHPB).Row, 3).End(xlUp).Row + 1
  'si cette ligne est inférieure à 19 alors Newlig = 19
  If newlig < 19 Then newlig = 19
  Debug.Print newlig
End With

[grisan29]

bonjour zyhack

merci beaucoup de ta réponse, mais je ne comprends ce que me fait ta formule car lors de son activation elle me fait des lignes pointillées exactement comme si je voulais faire une mise en page, pour une meilleur compréhension je vais joindre mon fichier avec ta formule et tu te rendra mieux compte de ce qu'il faut fairece n'est pas le bon fichier car il est trop lourd, le bouton est en feuil plomberie
c'est la feuil1 qui sert de destination,(avec ce fichier il y a un code erroné)

je voudrais également que lors de l'ajout d'article une ligne soit créer a la suite et ce jusque la ligne 40 env et faire un saut sur le bas de page et repartir sur une autre feuille en 6ème ligne env

excuse moi du retard a répondre mais mon chantier actuel est trop loin de chez moi et je reste la semaine sur place

bon week end

Pascal

[zyhack]

Bonjour

mais je ne comprends ce que me fait ta formule car lors de son activation elle me fait des lignes pointillées exactement comme si je voulais faire une mise en page

C'est effectivement le cas car j'utilisais la détection des saut de page.

je voudrais également que lors de l'ajout d'article une ligne soit créer a la suite et ce jusque la ligne 40 env et faire un saut sur le bas de page et repartir sur une autre feuille en 6ème ligne env

Faire un saut sur le bas de page ?
Et repartir sur une autre feuille ?

Alors dans ce code j'ai fais de manière à ce que tu puisse modifier toi même à partir de quelle ligne tu veux que les données commences à être écrite en modifiant la valeur de la variable PremiereLigne

ainsi que le nombre maximum de ligne de la feuille en modifiant la variable derniereLigne

Je n'ai rien vu dans ton code qui gène le fait de chercher la 1er ligne vide en partant de la fin.

Ainsi lorsque la ligne à écrire arrive à 41 elle passe automatiquement à 46.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub CommandButton2_Click()
Dim newLig As Long
Dim PremiereLigne As Long
Dim derniereLigne As Long
With Sheets("feuil1")
 
PremiereLigne = 6
derniereLigne = 40
  'Chercher la premiere ligne vide
  newLig = .Cells(Rows.Count, 3).End(xlUp).Row + 1
  'si cette ligne est est > au nombre autorisé
  If newLig - (Int(newLig / derniereLigne) * derniereLigne) = 1 Then
    newLig = (Int(newLig / derniereLigne) * derniereLigne) + PremiereLigne
  End If
 
   .Range("B" & newLig).Value = TextBox1.Value ' designation
   .Range("D" & newLig).Value = TextBox2.Value ' prix
   .Range("E" & newLig).Value = TextBox3.Value ' unite
   .Range("C" & newLig).Value = TextBox4.Value ' qte
   .Range("F" & newLig).Value = .Range("C" & newLig).Value * .Range("D" & newLig).Value
   .Range("G" & newLig).Value = IIf(Me.OptionButton5, 1, 2)
   .Range("H" & newLig).Value = IIf(Me.OptionButton5, 0.055 * .Range("F" & newLig).Value, "")
   .Range("I" & newLig).Value = IIf(Me.OptionButton6, 0.196 * .Range("F" & newLig).Value, "")
   '.....
End With
 
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End Sub

[grisan29]

bonjour zyhack

j'ai modifié mon fichier qui était trop lourd pour le dernier post et celui que je t'ai envoyer ne correspond pas a la réalité,
le code que tu a modifié fonctionne a merveille a partir de la derniere ligne vide hors mon fichier contient du texte en bas de page et il commence après
il faudrai qu'il commence a la ligne 19 et finir a 50/51 puis
faire un saut au dessus du bas de page et repartir sur une autre page en emportant avec lui la ligne 16 pour l'inscrire en 2ème page ligne 4 et repartir jusque la 51 et répéter si nécessaire et en fin d'écriture décaler le bas de page 1 en fin de l'autre page x

merci pour tout

pascal

[zyhack]

Bonjour

avec cette appli je vois déjà mieux ce qu'il y a à remplir mais il reste deux points dans ta phrase

il faudrai qu'il commence a la ligne 19 et finir a 50/51 puis faire un saut au dessus du bas de page

aucune idée de ce que ça veut dire

et repartir sur une autre page en emportant avec lui la ligne 16 pour l'inscrire en 2ème page ligne 4 et repartir jusque la 51 et répéter si nécessaire et en fin d'écriture décaler le bas de page 1 en fin de l'autre page x

par contre pour celle là je pense avoir compris que,
- arrivé en ligne 51
- il faut créer une nouvelle feuille
- Copier la ligne 16 et la mettre en ligne 4 de cette nouvelle page
- commencer à écrire en ligne 19 jusque 51

c'est bien ça ?

[grisan29]

bonsoir zyhack

merci de ta réponse
tes pensées sont juste, malgré que je pense que le fichier que tu a eu n'est pas encore le bon, car la feuille facturation ne devrai avoir que la ligne 19 et 20 de bordurée et justement pour une facture d'acompte c'est amplement suffisant, mais pour une facture ou devis,
la 1ere feuille devrai demarrer a la ligne 19 et lors de l'ajout d'une prestations x a la suite, doit ajouté une ligne a chaque fois, afin qu'une fois arrivé a ligne 50/51 elle fait un saut sur le bas de page et repart sur une autre feuille en emportant avec elle la ligne 16 pour la coller en ligne 4/5 de la nouvelle feuille , et que le bas de page1 se déplace également si la facture se suffit a 2 feuilles il faut également coller tout le bas a la suite sinon ce sera sur le haut ou bas de la troisième feuille,
en somme il faudrait que la formule sache quand la facture/devis est fini pour coller le bas de page

autre chose je voudrais faire une facture a partir d'un devis ,une recopie en fait , quel est la meilleur solution

voici a peu pres je qu'il faudrait et je pense que tu devra me redemandé des précisions

merci pour tout pascal

[zyhack]

Bonjour grisant29

Alors voila une grosse partie de réalisé, pour plus de simplicité j'ai créé une Fonction dans un module standard qui s'occupe de tout pour savoir ou écrire.

Chercher la premiere ligne vide dans la ou les feuilles
Quand la feuille est pleine en créer une autre qui porte le même nom avec un indice Facturation(x)
Mettre en forme la nouvelle feuille
Ecrire les formules
...

Il n'est pas complet mais il te donnera une bonne base de départ avec plein d'exemple et de commentaires pour que tu puisse avancer.

Modification du code dans userForm1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub CommandButton2_Click()
Dim newLig As Long
Dim result As String, OuEcrire() As String
 
OuEcrire = Split(LigneSuivante, ",")
newLig = CLng(OuEcrire(1))
 
With Sheets(OuEcrire(0))
   .Range("C" & newLig).Value = TextBox1.Value ' designation
   .Range("I" & newLig).Value = TextBox2.Value ' prix
   .Range("J" & newLig).Value = TextBox3.Value ' unite
   .Range("K" & newLig).Value = TextBox4.Value ' qte
   .Range("L" & newLig).Value = .Range("K" & newLig).Value * .Range("I" & newLig).Value
   .Range("M" & newLig).Value = IIf(Me.OptionButton5, 1, 2)
   .Range("O" & newLig).Value = IIf(Me.OptionButton5, 0.055 * .Range("L" & newLig).Value, "")
   .Range("P" & newLig).Value = IIf(Me.OptionButton6, 0.196 * .Range("L" & newLig).Value, "")
   '.....
End With
 
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End Sub

Code a ajouter dans un nouveau module standard (Module2 par exemple)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
Function LigneSuivante() As String
  'Ligne début et fin d'écriture sur la feuille Facturation
Const LigneMinFact1 As Byte = 19, LigneMaxFact1 As Byte = 51
  'Ligne début et fin d'écriture sur les feuilles Facturation suivante
Const LigneMinFactS As Byte = 6, LigneMaxFactS As Byte = 51
 
Dim NouvelleFeuille As Worksheet
Dim Cellule As Range
Dim Boucle As Byte
Dim test As String, nomFeuille As String
 
LigneSuivante = ""
 
'chercher si une ligne est vide dans la feuille facturation
With Worksheets("Facturation")
  For Each Cellule In .Range(.Cells(LigneMinFact1, 3), .Cells(LigneMaxFact1, 3))
    If Cellule = "" Then
      LigneSuivante = "Facturation," & Cellule.Row
      Exit For
    End If
  Next
  'si une ligne vide est trouvé -> sortir
  If LigneSuivante <> "" Then Exit Function
End With
 
For Boucle = 2 To 255
  'Vérifier si une autre feuille facturation existe
  nomFeuille = "Facturation(" & Boucle & ")"
  On Error Resume Next
  test = Sheets(nomFeuille).Name
  On Error GoTo 0: Err.Clear
 
  If test <> nomFeuille Then 'la feuille n'existe pas il faut la créer
    Set NouvelleFeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    NouvelleFeuille.Name = nomFeuille
 
    'Collage des ligne à reporter
        'en-tête
    Sheets("facturation").Rows("16:17").Copy
    NouvelleFeuille.Range("A4").PasteSpecial Paste:=xlPasteValues
    NouvelleFeuille.Range("A4").PasteSpecial Paste:=xlPasteFormats
        'Format tableau des lignes
    Sheets("facturation").Rows("20:20").Copy
    NouvelleFeuille.Rows("6:50").PasteSpecial Paste:=xlPasteFormats
        'les deux dernieres ligne
    Sheets("facturation").Rows("51:52").Copy
    NouvelleFeuille.Range("A51").PasteSpecial Paste:=xlPasteFormats
        'Largeur des colonnes
    Sheets("facturation").Cells.Copy
    NouvelleFeuille.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
 
        'Réécriture des formules
    With NouvelleFeuille
      .Range("L52").FormulaLocal = "=SOMME(L" & LigneMinFactS & ":L" & LigneMaxFactS & ")"
      .Range("O52").FormulaLocal = "=SOMME(O" & LigneMinFactS & ":O" & LigneMaxFactS & ")"
      .Range("P52").FormulaLocal = "=SOMME(P" & LigneMinFactS & ":P" & LigneMaxFactS & ")"
    End With
 
    LigneSuivante = nomFeuille & "," & LigneMinFactS
    'comme la feuille vient d'être créé on sait ou ecrire donc quitter la fonction
    Exit Function
  Else
 
    'chercher si une ligne est vide dans la feuille facturation(x)
    With Worksheets(nomFeuille)
      For Each Cellule In .Range(.Cells(LigneMinFactS, 3), .Cells(LigneMaxFactS, 3))
        If Cellule = "" Then
          LigneSuivante = nomFeuille & "," & Cellule.Row
          Exit For
        End If
      Next
      'si une ligne vide est trouvé -> sortir
      If LigneSuivante <> "" Then Exit Function
    End With
  End If
Next
End Function

[grisan29]

bonjour zyhack

en effet c'est une tres grosse partie de faite, je n'ai pas encore pris le temps de tout tester mais l'ajout de prestations rien a dire c'est nickel, il y a quand même un bemol
j'aurais préférer que la formule ajoute une ligne après chaque 2ème insertion de prestation soit lors du remplissage de la ligne 19 il faudrait que la formule ajoute une ligne a chaque insertion d'article et cela jusque la ligne 50/51 pour passer en page2 continuer de même, car lorsque je recois l'accord d'un devis la loi oblige a retourner une facture d'acompte mais cela ne prends du'1 ligne de prestations
merci quand même beaucoup de ce que tu as fait, je sais que Paris ne sais pas fait en un jour et je suis patient

j'ai fait l'essai de saut page automatique et c'est un succes inespéré je ne te remercierais jamais assez de ce que tu fait

merci beaucoup je suis pret a cliquer sur résolu meme maintenant je crois tellement la performance que dégage ta connaissance en vba me clou sur ma chaise

bonne continuité et bonne soirée

Pascal

[zyhack]

Bonsoir

Comme je le dis tous le temps plus les questions sont précises et complètes plus les réponses le sont.

j'aurais préférer que la formule ajoute une ligne après chaque 2ème insertion de prestation soit lors du remplissage de la ligne 19 il faudrait que la formule ajoute une ligne a chaque insertion d'article et cela jusque la ligne 50/51

si j'ai bien compris tu désire qu'une ligne sur deux soient remplis.

car lorsque je recois l'accord d'un devis la loi oblige a retourner une facture d'acompte mais cela ne prends du'1 ligne de prestations

la, j'avoue que je sèche ?

je suis pret a cliquer sur résolu meme maintenant

Attends au moins d'avoir terminé ou tu peux le mettre en résolu, travailler de ton coté et reposer une autre question quand tu sera bloqué.

au plaisir,

[grisan29]

bonsoir zyhack


ce n'est pas tout a fait une ligne sur2 mais on peut le penser en effet, une ligne écrite = une ligne ajoutée avec ses formules
j'ai eu une formule avant mais qui fonctionne a l'aide d'un bouton mais rien vaut l'automatisme dont voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub AjouterItem()
' Macro Dan le 17/01/2010
' ajouter un enregistrement
Dim a As Integer, lig As Integer
a = MsgBox("Voulez-vous ajouter un enregistrement ?", vbYesNo + vbQuestion, "Ajouter")
If a = vbYes Then
lig = Range("B19").End(xlDown)(1).Row
Range("B19").End(xlDown)(1).EntireRow.Insert
Range("C" & lig + 1).Copy Range("C" & lig)
Range("K" & lig + 1 & ":L" & lig + 1).Copy Range("K" & lig)
Range("O" & lig + 1 & ":P" & lig + 1).Copy Range("O" & lig)
Range("B19:M" & lig + 1).Sort Key1:=Range("B19"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

si ce code peux te servir n'hésite pas

J"ai fait un essai avec le code de saut de page et nickel, mais apres avoir fait un apercu d'impression il n'y a que la feuile 1 qui est prise en comptehors si je fait une facture 3 feuilles il faudrait qu'elle s'imprime toutes l'une apres l'autre

merci pour tout

Pascal

[zyhack]

Bonjour grisan29

J'ai modifié le code de la fonction pour que l'ajout de ligne soit automatique jusque la ligne 51 et qu'il en soit de même sur la page suivante.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
Function LigneSuivante() As String
  'Ligne début et fin d'écriture sur la feuille Facturation
Const LigneMinFact1 As Byte = 19, LigneMaxFact1 As Byte = 51
  'Ligne début et fin d'écriture sur les feuilles Facturation suivante
Const LigneMinFactS As Byte = 7, LigneMaxFactS As Byte = 51
 
Dim NouvelleFeuille As Worksheet
Dim Cellule As Range
Dim Boucle As Byte
Dim test As String, nomFeuille As String
 
LigneSuivante = ""
 
'chercher si une ligne est vide dans la feuille facturation
With Worksheets("facturation")
  For Each Cellule In .Range(.Cells(LigneMinFact1, 3), .Cells(LigneMaxFact1, 3))
    If Cellule = "" Then
      LigneSuivante = "facturation," & Cellule.Row
      Exit For
    End If
  Next
  If Not Cellule Is Nothing Then _
    If Cellule.Row > LigneMinFact1 And Cellule.Row < LigneMaxFact1 Then .Rows(Cellule.Row).Insert Shift:=xlDown
  'si une ligne vide est trouvé -> sortir
  If LigneSuivante <> "" Then Exit Function
End With
 
For Boucle = 2 To 255
  'Vérifier si une autre feuille facturation existe
  nomFeuille = "facturation(" & Boucle & ")"
  On Error Resume Next
  test = Sheets(nomFeuille).Name
  On Error GoTo 0: Err.Clear
 
  If test <> nomFeuille Then 'la feuille n'existe pas il faut la créer
    Set NouvelleFeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    NouvelleFeuille.Name = nomFeuille
 
    'Collage des ligne à reporter
        'en-tête
    Sheets("facturation").Rows(LigneMinFact1 - 3 & ":" & LigneMinFact1 - 1).Copy
    NouvelleFeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteValues
    NouvelleFeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteFormats
        'Format tableau des lignes
    Sheets("facturation").Rows(LigneMinFact1).Copy
    NouvelleFeuille.Rows(LigneMinFactS).PasteSpecial Paste:=xlPasteFormats
        'les deux dernieres ligne
    Sheets("facturation").Rows(LigneMaxFact1 & ":" & LigneMaxFact1 + 1).Copy
    NouvelleFeuille.Rows(LigneMinFactS + 1 & ":" & LigneMinFactS + 2).PasteSpecial Paste:=xlPasteFormats
        'Largeur des colonnes
    Sheets("facturation").Cells.Copy
    NouvelleFeuille.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
 
        'Réécriture des formules
    With NouvelleFeuille
      .Range("L" & LigneMinFactS + 2).FormulaLocal = "=SOMME(L" & LigneMinFactS & ":L" & LigneMinFactS + 1 & ")"
      .Range("O" & LigneMinFactS + 2).FormulaLocal = "=SOMME(O" & LigneMinFactS & ":O" & LigneMinFactS + 1 & ")"
      .Range("P" & LigneMinFactS + 2).FormulaLocal = "=SOMME(P" & LigneMinFactS & ":P" & LigneMinFactS + 1 & ")"
    End With
 
    LigneSuivante = nomFeuille & "," & LigneMinFactS
    'comme la feuille vient d'être créé on sait ou ecrire donc quitter la fonction
    Exit Function
  Else
 
    'chercher si une ligne est vide dans la feuille facturation(x)
    With Worksheets(nomFeuille)
      For Each Cellule In .Range(.Cells(LigneMinFactS, 3), .Cells(LigneMaxFactS, 3))
        If Cellule = "" Then
          LigneSuivante = nomFeuille & "," & Cellule.Row
          Exit For
        End If
      Next
      If Not Cellule Is Nothing Then _
        If Cellule.Row > LigneMinFactS And Cellule.Row < LigneMaxFactS Then .Rows(Cellule.Row).Insert Shift:=xlDown
      'si une ligne vide est trouvé -> sortir
      If LigneSuivante <> "" Then Exit Function
    End With
  End If
Next
End Function

regarde déjà si c'est ce que tu attend.

[grisan29]

bonjour zyhack

la derniere formule que tu a mis sur le forum est nickel, elle passe a une autre feuille apres la ligne 51 et ce même a la seconde feuille vers la 3 eme
il n'y a plus rien a dire de plus pour la formule pour l'instant
il lui manque juste la numérotation des feuilles et l'impression des feuilles l'une apres l'autre et aussi amener avec elle le bas de page 1 a la fin de la creation du devis/facture
merci pour tout a toi et au forum

bonne continuation

pascal

[zyhack]

Bonjour

amener avec elle le bas de page 1 a la fin de la creation du devis/facture

Pour ce point je peux te proposer une routine pour cloturer le Devis/facture que tu pourrais appeler avec un bouton car sinon je ne vois pas comment lui dire que la saisie est terminé. Comme d'habitude j'ai testé le code avec ton fichier.

ce code coupe les lignes 54 à 67 de la feuille facturation et les colles à la fin de la dernière feuille facturation
Les formules sont modifiés pour efectuer le total de toutes les feuilles
La validation de certaines cellules est remise à jour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub cloturer()
Dim wsh As Worksheet, nbWsh As Integer, boucle As Integer, ligne As Integer
Dim f1 As String, f2 As String, f3 As String
nbWsh = 0
For Each wsh In Worksheets
  If InStr(1, wsh.Name, "facturation") > 0 Then nbWsh = nbWsh + 1
Next
 
If nbWsh > 1 Then
  f1 = "=facturation!L52" 'Montant HT
  f2 = "=facturation!O52" 'TVA  5,5
  f3 = "=facturation!P52" 'TVA 19,6
  For boucle = 2 To nbWsh
    If nbWsh > boucle Then
      f1 = f1 & "+ facturation(" & boucle & ")!L52"
      f2 = f2 & "+ facturation(" & boucle & ")!O52"
      f3 = f3 & "+ facturation(" & boucle & ")!P52"
    Else
      ligne = Worksheets("facturation(" & boucle & ")").Cells(Rows.Count, 12).End(xlUp).Row
      f1 = f1 & "+ L" & ligne
      f2 = f2 & "+ O" & ligne
      f3 = f3 & "+ P" & ligne
    End If
  Next
  With Worksheets("facturation(" & nbWsh & ")")
    Sheets("facturation").Rows("54:67").Cut .Cells(ligne + 2, 1)
    .Cells(ligne + 2, 7).Formula = f2
    .Cells(ligne + 3, 7).Formula = f3
    .Cells(ligne + 4, 12).Formula = f1
    .Cells(ligne + 5, 4).Validation.Delete
    .Cells(ligne + 5, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="=" & .Range(.Cells(ligne + 4, 1), .Cells(ligne + 6, 1)).Address
    .Cells(ligne + 6, 4).Validation.Delete
    .Cells(ligne + 6, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="=" & .Range(.Cells(ligne + 10, 1), .Cells(ligne + 11, 1)).Address
    .Cells(ligne + 8, 3).Validation.Delete
    .Cells(ligne + 8, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="=" & .Range(.Cells(ligne + 13, 1), .Cells(ligne + 14, 1)).Address
  End With
End If
End Sub

[grisan29]

Bonjour zyhack et le forum


il n'y rien a dire le professionnel que tu est a fait joué ses compétences et le fichier fonctionne cette fois comme il faut a priori
un grand merci pour les déboires que je t'ai causé

j'ai oublier de te demander en plus de cette formule sous quel formule puis-je intégré le retour a 2 lignes (19 et 20) de la feuille1 quand le devis/facture est fine et doit etre valider par le bouton nouvelle facture(qui est a modifié)
je vais essayer ce week end et je te tiens au courant de ce que j'aurai fait

bonne continuation a toi et tout le forum

bonne journée

pascal