Tableau de facturation : automatiser suivi d'émission
Bonjour à tous,
Je fais appel à votre aide car je rencontre un problème auquel je ne trouve pas de solutions.
Je génère des templates de factures depuis un tableau excel composé de plusieurs feuilles.
Ces feuilles correspondent aux différents blocs d’un projet immobilier que l’on vend.
Chaque bloc est vendu en plusieurs tranches selon l’avancement des travaux. (un bloc peut faire l’objet d’une facturation en 9 tranches alors qu’un autre sera facturé en 3 tranches).
De plus, le projet n’étant pas entièrement prévendu, et se vendant au fur et à mesure, il se peut, lors de la signature qu’on puisse déjà lui facturer plusieurs tranches à la fois, le chantier ayant avancé entre temps.
J’injecte ensuite ces templates dans mon logiciel comptable et émet ainsi mes factures.
Mon code, qui est assez simple (mais sans doute mal écrit donc moyennement lisible), ne me permet pas, à ce jour, de faire tout ce que je souhaiterai faire.
Je souhaiterai améliorer ce code de manière à ce qu’il puisse effectuer les tâches suivantes :
- D’une part, alimenter une feuille de suivi de ces émissions de factures; cela se traduierait par le changement de couleur de fonds des cellules lorsque une facture est émise pour un acquéreur X et une tranche Y; le fond de la cellule pour cette tranche/acquéreur deviendrait vert.
- D’autre part lors de la prochaine génération de factures, ajouter dans les conditions un check de la feuille de suivi afin de ne pas émettre deux fois la même facture. si la case dans la feuille de suivi est en “vert” ne pas réemmettre la même facture.
Mes clients sont identifiés par un n° qui je pense doit être la données qui sert de comparaison.
Vous trouverez ci-joint un tableau avec le code que j’ai actuellement.
Attention : à noter qu’un même client peut très bien avoir acheté un appartement et un parking, mais selon l’avancement des travaux ne se voir facturer que le parking ou l’appartement.
Je ne suis pas certains d’avoir été très clair donc n’hésitez pas à me poser d’autres questions; je suis preneur de toute solution / idée de solution .
Merci d'avance !
Bonjour,
j'ai "nettoyé" ton code
Sub Invoice_template_generator4()
Dim numero%, commande%, tranche%, libelle$, datecommande As Date, dernligne As Long, maxindex%, ncommande%
'-----
maxindex = Application.WorksheetFunction.Max(Worksheets("IndexCommande").Range("a:a"))
tranche = 0
numero = 2
libelle = ""
'-----
Sheets.Add
'-----
ActiveSheet.Name = InputBox("Pour quelle tranche souhaitez-vous gŽnŽrer le template (tranche_1 / tranche_2 / ...) :")
libelle = InputBox("Veuillez entrer le libellŽ du projet (ex: PARKINGS - Projet Immobilier) :", Default:="PARKINGS")
datecommande = InputBox("Veuillez entrer la date de facturation (ex : 21/10/17) :")
ncommande = InputBox("Veuillez indiquer l'index du n¡ de commande : ATTENTION le n¡ doit etre supŽrieur ˆ " & maxindex)
'-----
Range("A1").Value = "Ligne en-tte"
Range("B1").Value = "N¡ commande"
Range("C1").Value = "CommandŽ par"
Range("D1").Value = ""
Range("E1").Value = "Facture pour"
Range("F1").Value = ""
Range("G1").Value = "Date commande"
Range("H1").Value = "LibellŽ"
Range("I1").Value = "Remarques"
Range("J1").Value = "Val."
Range("K1").Value = "Code article"
Range("L1").Value = "Nombre"
Range("M1").Value = "Prix unitaire"
Range("N1").Value = "Prix net"
Range("O1").Value = "Code unitŽ"
Range("P1").Value = "Code TVA"
Range("Q1").Value = "% TVA"
Range("R1").Value = "PaymentCondition"
'-----
dernligne = Range("A" & Rows.Count).End(xlUp).Row
'-----
For i = 4 To 26
If Worksheets("PARKINGS").Range("N" & i).Value <> "" And Worksheets("PARKINGS").Range("N" & i).Value <= Now() Then
ActiveSheet.Range("C" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("D" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("E" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("F" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("I" & dernligne + 1) = Worksheets("PARKINGS").Range("I" & i)
If ActiveSheet.Name Like "*1*" Then
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
ElseIf ActiveSheet.Name Like "*2*" Then
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
ElseIf ActiveSheet.Name Like "*3*" Then
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
ElseIf ActiveSheet.Name Like "*4*" Then
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
End If
dernligne = dernligne + 1
End If
Next i
'-----
While Cells(numero, 9) <> ""
Cells(numero, 1) = "H"
Cells(numero, 2) = ncommande
Cells(numero, 7) = datecommande
Cells(numero, 8) = libelle
Cells(numero, 10) = "EUR"
Cells(numero, 11) = tranche
Cells(numero, 12) = 1
Cells(numero, 15) = "pc"
Cells(numero, 16) = 5
Cells(numero, 17) = 21
Cells(numero, 18) = 15
numero = numero + 1
Wend
'-----
Sheets("IndexCommande").Unprotect Password:="motdepasse"
Worksheets("IndexCommande").Cells(Rows.Count, 1).End(xlUp)(2) = Application.WorksheetFunction.Max(ActiveSheet.Range("b:b"))
Sheets("IndexCommande").Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:="motdepasse"
'-----
ActiveSheet.Copy
With ActiveWorkbook
.Title = ActiveSheet.Name
.Subject = ActiveSheet.Name
.SaveAs Filename:="PARKINGS_Loi_Breyne_" + ActiveSheet.Name + ".xls", FileFormat:=xlExcel8, CreateBackup:=False
End With
End Sub
@+JP
Bonjour JP,
Merci beaucoup d'avoir nettoyé le code.
Cela m'aide à m'améliorer dans la manière d'écrire en VBA !
Cependant je ne vois pas la partie du code qui exécute les améliorations :
- colorer les tranches de facturation déjà émises dans la feuille "SUIVI EMISSION FACTURE" et
- checker cette feuille lors de la prochaine exécution de la macro
Bonjour,
ton code ne fonctionnait pas..., il fallait dans un premier temps le rendre opérationnel
maintenant il parait fonctionner ,
à toi de dire si le résultat actuel est correct
et avec un exemple concret , c'est à dire telle case va ici ou là et elle doit être de telle couleur ou pas ...
avec ces explications on pourra "améliorer" ton code
@+JP
Le résultat est Nickel !
Pour ce qui est des améliorations , voici ce que je souhaiterai faire :
Si par exemple j'exécute ma macro sur la feuille Parkings pour la tranche 1:
cela va générer le template avec 4 lignes donc 4 factures dans l'exemple du fichier envoyé, car la date de la tranche 1 (31/05/2018) est supérieure aux dates de signatures d'acte des quatre acquéreurs.
Et bien je souhaiterai que lorsque ces factures sont générées , la cellule correspondant à cette tranche dans la feuille "SUIVI EMISSION FACTURE" (par exemple: pour la tranche 1 des parkings de l'acquéreur "Jean Samuraï" c'est la cellule S61 de la feuille "SUIVI EMISSION FACTURE") ait le fond qui passe en VERT.
De plus je souhaiterai un boût de code qui fasse un "check" du fond des cellules de la feuille "SUIVI EMISSION FACTURE" avant émission.
Autrement dit, dans cet exemple, si j'émet la tranche 1 du parking de Jean Samuraï , elle passe en vert.
Entre temps, j'ai vendu d'autres parkings et je souhaite émettre la tranche 1 à nouveau pour d'autre client : et bien avec l'amélioration, ça ne réemmettrait pas la facture pour tranche 1 de Jean Samuraï parce que son fond serait vert.
J'espère avoir était clair ...
Merci d'avance de votre aide
Bonjour,
le fichier modifié_JP_Vert
le résultat : la "Mise au Vert"
les nouveaux codes
l' appel :
Call MiseAuVert(libelle, ActiveSheet.Name)
la procédure de Mise au vert :
Private Sub MiseAuVert(LibelleType As String, TrancheNum As String)
Dim LigneDebut As Long
Dim DerniereLigne As Long
Dim CibleNum As String
'-----
LigneDebut = 0
'recherche du titre PARKINGS par exemple
Do
n = n + 1
If Sheets("SUIVI EMISSION FACTURE").Cells(n, 2).Value = LibelleType Then
LigneDebut = n 'MsgBox n
Exit Do
End If
'do loop est une boucle sans fin alors par sécurité on arrete à 1000 (ou avant si tu veux)
If n = 1000 Then
MsgBox "Tableau " & LibelleType & "... pas trouvé"
Exit Do
End If
Loop
'si on a trouvé , LigneDebut n'est plus 0
If LigneDebut > 0 Then
'dans l' onglet qui a le même nom de la tranche / TrancheNum
'on regarde la colonne "E" qui est la 5° colonne
'les numéro de "Facture pour"
DerniereLigne = Sheets(TrancheNum).Range("E" & Rows.Count).End(xlUp).Row
For n = 2 To DerniereLigne
CibleNum = Sheets(TrancheNum).Range("E" & n).Value
'on recherche la ligne qui correspond à CibleNum
n2 = LigneDebut
Do
n2 = n2 + 1
If Sheets("SUIVI EMISSION FACTURE").Cells(n2, 1).Value = CibleNum Then
LigneCible = n2
'la cible est trouvée..on peint en vert
'tranche 1 = "S" la colonne 19..donc colonne 18 + tranche 1 = "S"
Sheets("SUIVI EMISSION FACTURE").Cells(n2, 18 + TrancheNum).Interior.ColorIndex = 4
Exit Do
End If
'do loop est une boucle sans fin alors par sécurité on arrete à 1000 (ou avant si tu veux)
If n2 = 1000 Then
MsgBox "Tableau " & LibelleType & "... la Ligne pour : " & CibleNum & " n'a pas été trouvée"
Exit Do
End If
Loop
Next n
End If
End Sub
à suivre la gestion des couleurs
@+JP
Merci beaucoup de prendre le temps de me répondre et de ta réactivité JP.
Je vais prendre le temps d'analyser ton code (d'ailleurs top les commentaires pour ça) !
En l'exécutant j'ai une erreur "13 : incompatibilité de type" mais c'est peut être dû au fait que j'utilise excel sous Mac.
Bonjour,
alors regarde cette modif
For i = 4 To 26
If Worksheets("PARKINGS").Range("N" & i).Value <> "" Then
If Worksheets("PARKINGS").Range("N" & i).Value <= Now() Then
'contrôle de la couleur vert
ActiveSheet.Range("C" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("D" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("E" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("F" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("I" & dernligne + 1) = Worksheets("PARKINGS").Range("I" & i)
If ActiveSheet.Name Like "*1*" Then
Worksheets("PARKINGS").Range("AM" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AM" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
ElseIf ActiveSheet.Name Like "*2*" Then
Worksheets("PARKINGS").Range("AN" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AN" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
ElseIf ActiveSheet.Name Like "*3*" Then
Worksheets("PARKINGS").Range("AO" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AO" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
ElseIf ActiveSheet.Name Like "*4*" Then
Worksheets("PARKINGS").Range("AP" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AP" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
End If
dernligne = dernligne + 1
End If
End If
Next i
normalement , dans ton tableau en AM6 tu as un commentaire
c'est en plus des cases vertes , çà sert à contrôler si c'est traité...pas pris en compte
@+JP
Bonjour,
voila le code modifié pour ne pas prendre en compte les opérations
qui on été traitées et qui on reçue un commentaires et des cases vertes...
For i = 4 To 26
If Worksheets("PARKINGS").Range("N" & i).Value <> "" Then
If Worksheets("PARKINGS").Range("N" & i).Value <= Now() Then
If ActiveSheet.Name Like "*1*" Then
'teste s'il existe un commentaire
If Not Worksheets("PARKINGS").Range("AM" & i).Comment Is Nothing Then
'il existe un commentaire
TraitementDoc = True
Else
'il n'existe pas de commentaire
TraitementDoc = False
Worksheets("PARKINGS").Range("AM" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AM" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AM" & i)
End If
ElseIf ActiveSheet.Name Like "*2*" Then
If Not Worksheets("PARKINGS").Range("AN" & i).Comment Is Nothing Then
TraitementDoc = True
Else
TraitementDoc = False
Worksheets("PARKINGS").Range("AN" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AN" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AN" & i)
End If
ElseIf ActiveSheet.Name Like "*3*" Then
If Not Worksheets("PARKINGS").Range("AO" & i).Comment Is Nothing Then
TraitementDoc = True
Else
TraitementDoc = False
Worksheets("PARKINGS").Range("AO" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AO" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AO" & i)
End If
ElseIf ActiveSheet.Name Like "*4*" Then
If Not Worksheets("PARKINGS").Range("AP" & i).Comment Is Nothing Then
TraitementDoc = True
Else
TraitementDoc = False
Worksheets("PARKINGS").Range("AP" & i).AddComment ("Traitée le " & Now())
Worksheets("PARKINGS").Range("AP" & i).Comment.Visible = False
ActiveSheet.Range("M" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
ActiveSheet.Range("N" & dernligne + 1) = Worksheets("PARKINGS").Range("AP" & i)
End If
End If
If TraitementDoc = False Then
'il n'existe pas de commentaire
ActiveSheet.Range("C" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("D" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("E" & dernligne + 1) = Worksheets("PARKINGS").Range("A" & i)
ActiveSheet.Range("F" & dernligne + 1) = Worksheets("PARKINGS").Range("E" & i)
ActiveSheet.Range("I" & dernligne + 1) = Worksheets("PARKINGS").Range("I" & i)
dernligne = dernligne + 1
End If
End If
End If
Next i
pour le fichier modifié_JP
@+JP
Bonjour JP et merci infiniment pour tes réponses .
Lorsque j'exécute le code j'ai une erreur 13 incompatibilité de type qui apparaît sur la ligne suivante :
Sheets("SUIVI EMISSION FACTURE").Cells(n2, 18 + TrancheNum).Interior.ColorIndex = 4
apparemment c'est une erreur de variable.
C'est curieux que ça fonctionne chez vous mais pas chez moi.
Cela viendrait-il de la version d'excel utilisée ? j'utilise excel pour mac 2016
Edit: je pense que cela vient plutôt de la variable TrancheNum qui est une chaîne de caractère et de son utilisation dans Cells... je vais voir comment contourner cela
EDIT 2 : j'ai trouvé une solution: remplacer
Sheets("SUIVI EMISSION FACTURE").Cells(n2, 18 + TrancheNum).Interior.ColorIndex = 4
Sheets("SUIVI EMISSION FACTURE").Cells(n2, 18 + Right(TrancheNum, 1)).Interior.ColorIndex = 4
Merci encore, je vais maintenant m'attarder sur la deuxième partie du code
bonjour,
essais :
Sheets("SUIVI EMISSION FACTURE").Cells(n2, 18 + val(TrancheNum)).Interior.ColorIndex = 4
@+JP
Super, ça fonctionne désormais !
Merci beaucoup de ton aide précieuse JP.
J'ai encore une 'tite question : pour l'enregistrement dans un autre classeur du template; concernant l'emplacement du disque dur où il l'enregistre, le fichier s'enregistre dans le dernier dossier qui a été utilisé ce qui n'est pas toujours idéal...
Comment pourrais-je dire en VBA d'enregistrer sur le bureau ou tout du moins dans le même répertoire que celui de mon classeur de base ?
On fonctionne avec dropbox et plusieurs personnes peuvent être amenées à générer des factures donc il faudrait que ça marche pour tous !
Vous remerciant par avance
bonjour,
le chemin où se trouve le classeur qui contient ce code
ThisWorkbook.Path
ne pas oublier le "\" ,
ThisWorkbook.Path & "\" & FichierName
@+JP