destination textbox et +

Version imprimable

bonjour a vous tous
je voudrais que le code suivant
Code:

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:

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:

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:

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

Hello,

Peut-être comme ceci
Code:

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

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:

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

Bonjour grisan29

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

Code:

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

20/06/2010, 13h53
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

Bonjour

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

variable à ajouter en début de code

Code:

1
2
 
Dim Address1erHPB As String

code modifié

Code:

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

25/06/2010, 21h16
grisan29

suite

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

Bonjour

Citation:

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.

Citation:

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 ? 8O
Et repartir sur une autre feuille ? :calim2:

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:

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

28/06/2010, 07h37
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
28/06/2010, 09h07
zyhack

Bonjour

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

Citation:

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 8O:aie:

Citation:

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 ?
30/06/2010, 20h35
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

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:

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:

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

01/07/2010, 21h00
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
01/07/2010, 21h36
zyhack

Bonsoir

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

Citation:

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.

Citation:

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 ?

Citation:

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,

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:

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

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:

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.

06/07/2010, 19h52
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

Bonjour

Citation:

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:

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

08/07/2010, 08h32
grisan29

finalité

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