Microsoft 365 Incrémenter et générer nouvelle facture vierge

chris63* · 20 Avril 2021

Bonjour à tous,

Sur un autre post (https://www.excel-downloads.com/thr...d1-historique-pb-si-plusieurs-pages.20056041/ ) , une âme charitable ^^ m'a trouvé la solution macro pour incrémenter et générer un nouveau devis.
Macro que je tente d'adapter à mon modèle de facture, en vain..

Ci-joint mon fichier

Merci d'avance pour votre aide
Chris

Phil69970 · 20 Avril 2021

Bonjour @chris63* , Sylvain

Je te propose :

VB:

Sub archiverfactures()

Application.ScreenUpdating = False
Dim NbLig&, Ligne&
NbLig = Application.Match("TOTAL H.T", Range("C:C"), 0)

If Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Item(1, 1) <> "" Then _
    Ligne = Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Rows.Count + 2 Else Ligne = 2

With Sheets("FACTURE")
    Sheets("HISTORIQUE_FACTURE").Range("A" & Ligne).Value = .Range("B17").Value         'N° Facture
    Sheets("HISTORIQUE_FACTURE").Range("B" & Ligne).Value = .Range("C7").Value          'Date Facture
    Sheets("HISTORIQUE_FACTURE").Range("C" & Ligne).Value = .Range("B11").Value         'Nom du client
 
    'Je ne sais pas ou se trouve le n° d'affaire ...

sylvanu · 20 Avril 2021

Bonjour Chris,
En changeant la ligne :

VB:

Ligne = Sheets("HISTORIQUE_FACTURE").Range("A65000").End(xlUp).Row + 1

L'erreur est supprimée.
Sans préjuger du reste que je n'ai pas regardé.

chris63* · 20 Avril 2021

Bonjour sylvanu,

Merci pour ta réponse, ça fonctionne parfaitement

Question pour me coucher moins bête : "A2" fonctionne sur le même genre de macro sur d'autres documents.. (et même tableau base de tableau d'historique) une raison particulière pour que ça ne fonctionne pas ici ?

Chris

sylvanu · 20 Avril 2021

Bonsoir,
Le mieux est d'essayer. En PJ un essai avec différentes configurations. On obtient :

Le [B10] = Range("B2").End(xlDown).Row + 1 ne marche que si on a plusiusr cellules occupées. Si il n'y a qu'une seule cellule, il renvoie le nombre max.
Avec [D12] = Range("D65000").End(xlUp).Row + 1 ça marche dans tous les cas.

Phil69970 · 20 Avril 2021

Bonjour @chris63* , Sylvain

Je te propose :

VB:

Sub archiverfactures()

Application.ScreenUpdating = False
Dim NbLig&, Ligne&
NbLig = Application.Match("TOTAL H.T", Range("C:C"), 0)

If Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Item(1, 1) <> "" Then _
    Ligne = Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Rows.Count + 2 Else Ligne = 2

With Sheets("FACTURE")
    Sheets("HISTORIQUE_FACTURE").Range("A" & Ligne).Value = .Range("B17").Value         'N° Facture
    Sheets("HISTORIQUE_FACTURE").Range("B" & Ligne).Value = .Range("C7").Value          'Date Facture
    Sheets("HISTORIQUE_FACTURE").Range("C" & Ligne).Value = .Range("B11").Value         'Nom du client
 
    'Je ne sais pas ou se trouve le n° d'affaire ????
    Sheets("HISTORIQUE_FACTURE").Range("E" & Ligne).Value = .Range("D" & NbLig).Value   'Affaire ??
 
    Sheets("HISTORIQUE_FACTURE").Range("F" & Ligne).Value = .Range("D39").Value         'Montant HT
    Sheets("HISTORIQUE_FACTURE").Range("G" & Ligne).Value = .Range("D40").Value         'TVA
    Sheets("HISTORIQUE_FACTURE").Range("H" & Ligne).Value = .Range("D41").Value         'Montant TTC
    Sheets("HISTORIQUE_FACTURE").Range("I" & Ligne).Value = .Range("D42").Value         'Accompte
    Sheets("HISTORIQUE_FACTURE").Range("I" & Ligne).Value = .Range("D43").Value         'Net à payer

    'Nettoyage facture
    .[C7,B11,D42].ClearContents
    .Range("A20:C" & NbLig - 2).ClearContents
 
    'Preparation nouveau N° de facture
    .Range("B17").Value = .Range("B17").Value + 1
End With

'Remise en place de la facture normalisée
Dim NbLigSup&
If NbLig > 39 Then NbLigSup = NbLig - 20: Rows("20:" & NbLigSup).Delete shift:=xlUp

End Sub

@Phil69970

chris63* · 21 Avril 2021

@sylvanu, @Phil69970, un bonjour pluvieux,

Merci à vous 2 pour vos réponses.

@sylvanu, ok, je comprend la logique
---------------

@Phil69970,
ça fonctionne très bien, j'ai modifié quelques petites choses :

'Je ne sais pas ou se trouve le n° d'affaire ???? : normal, je ne l'avais pas mis
------
'Nettoyage facture
.[C7,B11,D42].ClearContents
J'ai mis une date du jour automatique donc je ne l'efface plus. Par contre j'efface le n° d'affaire :

'Nettoyage facture
.[B11,D42,A13].ClearContents

Ce qui me donne ça (si ça peut servir à quelqu'un d'autre ;-) )

Est-ce-que tu peux m'expliquer ceci quand tu auras un moment ?
If Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Item(1, 1) <> "" Then _
Ligne = Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Rows.Count + 2 Else Ligne = 2

Merci à vous 2

Bonne journée

Chris

Phil69970 · 21 Avril 2021

Bonjour @chris63* , le forum

Comme tu as un tableau structuré "Tableau4" je regarde si tu as une valeur dans la 1ere cellule après les entêtes de la colonne 1 , en clair je regarde pour ce tableau la cellule A2 si elle est vide ou pas....
Si elle vide je peux la remplir ==> ligne 2 sinon je passe à la ligne suivante ==> entête + la ligne écrite donc + 2

chris63* à dit:
If Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Item(1, 1) <> "" Then _
Ligne = Worksheets("HISTORIQUE_FACTURE").Range("Tableau4").Rows.Count + 2 Else Ligne = 2

@Phil69970

chris63* · 21 Avril 2021

Phil69970 à dit:
Bonjour @chris63* , le forum

Comme tu as un tableau structuré "Tableau4" je regarde si tu as une valeur dans la 1ere cellule après les entêtes de la colonne 1 , en clair je regarde pour ce tableau la cellule A2 si elle est vide ou pas....
Si elle vide je peux la remplir ==> ligne 2 sinon je passe à la ligne suivante ==> entête + la ligne écrite donc + 2

@Phil69970

Ok,
'tableau4' .. ce qui pourrait expliquer que ça fonctionne bien pour le modèle "vierge" posté ici et pas sur mon modèle avec données persos sur lequel je souhaite appliquer la même macro. Le nom du tableau doit être différent...

Merci pour l'explication . Je regarde ça après la pause déjeuner et je reviens vers toi si besoin

_______________
EDIT : C'était bien le N° du tableau structuré !

Merci encore

(a bientôt sans doute )

Chris

Microsoft 365 Incrémenter et générer nouvelle facture vierge

chris63*

XLDnaute Nouveau

Pièces jointes

Phil69970

sylvanu

XLDnaute Barbatruc

chris63*

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

Pièces jointes

chris63*

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

chris63*

XLDnaute Nouveau

Discussions similaires