Correction de ma macro de facturation

**NOSLIB** · 22/05/2023, 14h40

Bonsoir ,

J'ai besoin de votre support la famille :

J'aimerai automatiser mon fichier de facturation excel avec une macro mais je rencontre plusieurs problemes:
La cellule C11 ne se met pas a jour automatiquement lorsque la cellule C9 est modifié, donc en resumé nous avons trois problèmes à resoudre avec cette macro :
Mettre les données de la cellule C11 à jour automaiquement quand C9 est modifié
deuxiement généré le poids total arrondi dans la cellule E102 lorsque le resultat du poids total s'affiche dans la cellule D102
Troisiemementgénérer automatiquement le tarif unitaire selon les conditions enumérées dans la macro.
Quatrième pouvoir mettre la date automatique lorsque le fichier est renseigné via une macro.
[ATTACH]639021[/ATTACHFacture Macro.xlsm]
Voici ci-dessous ma macro je vous ajoute également mon fichier excel.

Sub numeroFacture()

Dim numeroFacture As Long

' Remplacer "Mise à Fob" par le nom de votre feuille de travail
With ThisWorkbook.Sheets("Mise à Fob")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

If lastRow > 1 Then
numeroFacture = 1
Else
numeroFacture = 0
End If

.Cells(2, "C").Value = numeroFacture
End With
MiseAJourInfos
CalculerMontantFacture

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Mise à Fob") ' Remplacez "Mise à Fob" par le nom de votre feuille de travail

' Vérifier si le changement a eu lieu dans la plage des poids des marchandises (colonne D)
If Not Intersect(Target, ws.Range("D20

100")) Is Nothing Then
' Mise à jour du poids total arrondi (cellule E102) avec la somme des poids des marchandises arrondie à la tonne supérieure
ws.Range("E102").Value = Application.WorksheetFunction.Ceiling(Application.WorksheetFunction.Sum(ws.Range("D20

100")), 1)
CalculerMontantFacture ' Recalculer le montant de la facture après la mise à jour du poids total
End If

' Vérifier si le changement a eu lieu dans la cellule C9
If Target.Address = "$C$9" Then
MiseAJourInfos
CalculerMontantFacture ' Recalculer le montant de la facture après la mise à jour du type d'opération
End If
End Sub

Sub MiseAJourInfos()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Mise à Fob")

Dim nomSite As String
nomSite = ws.Cells(2, "C").Value

Select Case nomSite
Case "MAERSK SP0"
ws.Cells(4, "C").Value = "CI01MLOP64"
ws.Cells(5, "C").Value = "CI010110"
Case "GMCI"
ws.Cells(4, "C").Value = "CI01MLOP69"
ws.Cells(5, "C").Value = "CI010115"
Case "SACC/ETMD"
ws.Cells(4, "C").Value = "CI01MLOPLS"
ws.Cells(5, "C").Value = "CI010116"
Case "SITAPA"
ws.Cells(4, "C").Value = "CI01MLOP68"
ws.Cells(5, "C").Value = "CI010114"
Case "IROKOTARASNCI"
ws.Cells(4, "C").Value = "CI01MLOPL2"
ws.Cells(5, "C").Value = "CI010119"
End Select

Dim nbMarchandises As Double
nbMarchandises = Application.WorksheetFunction.CountA(ws.Range("C20:C100"))
ws.Cells(10, "C").Value = nbMarchandises

Dim typeOperation As String
typeOperation = ws.Cells(9, "C").Value

Select Case typeOperation
Case "Vrac"
ws.Cells(11, "C").Value = "20'"
Case "Sac"
ws.Cells(11, "C").Value = "40'"
Case "Conventionnel"
ws.Cells(11, "C").Value = "0"
End Select
End Sub

Sub CalculerMontantFacture()
' Remplacer "Mise à Fob" par le nom de votre feuille de travail
With ThisWorkbook.Sheets("Mise à Fob")
' Récupérer le poids total à facturer (cellule D102)
Dim poidsTotal As Double
poidsTotal = Application.WorksheetFunction.Sum(.Range("D20

101")) / 1000
.Cells(102, "D").Value = poidsTotal

' Récupérer le nom du client sélectionné
Dim nomClient As String
nomClient = .Cells(6, "C").Value

' Récupérer le type de prestation (cellule C13)
Dim typePrestation As String
typePrestation = .Cells(13, "C").Value

' Générer le tarif unitaire en fonction du nom du client et de sa prestation
Dim tarifUnitaire As Double
tarifUnitaire = ObtenirTarifUnitaire(nomClient, typePrestation)

' Placer le tarif unitaire dans la cellule F102
.Cells(102, "F").Value = tarifUnitaire

' Calculer le montant total à facturer (cellule G102)
Dim montantTotal As Double
montantTotal = poidsTotal * tarifUnitaire
.Cells(102, "G").Value = montantTotal
End With
End Sub

Function ObtenirTarifUnitaire(ByVal nomClient As String, ByVal typePrestation As String) As Double
' Insérez ici votre logique pour obtenir le tarif unitaire en fonction du nom du client et de sa prestation
' Par exemple, vous pouvez utiliser une table de correspondance ou une requête à une base de données
' Pour cet exemple, je vais simplement renvoyer un tarif unitaire fixe pour illustrer le concept

Select Case nomClient
Case "AFRICA SOURCING"
Select Case typePrestation
Case "Vrac"
ObtenirTarifUnitaire = 33000 ' Tarif unitaire pour le client 1 en cas de prestation Vrac
Case "Sac"
ObtenirTarifUnitaire = 31500 ' Tarif unitaire pour le client 1 en cas de prestation Sac
Case "Conventionnel"
ObtenirTarifUnitaire = 20500 ' Tarif unitaire pour le client 1 en cas de prestation Conventionnel
End Select
Case "SOCAGC"
Select Case typePrestation
Case "Vrac"
ObtenirTarifUnitaire = 31500 ' Tarif unitaire pour le client 2 en cas de prestation Vrac
Case "Sac"
ObtenirTarifUnitaire = 30000 ' Tarif unitaire pour le client 2 en cas de prestation Sac
Case "Conventionnel"
ObtenirTarifUnitaire = 19500 ' Tarif unitaire pour le client 2 en cas de prestation Conventionnel
End Select
Case Else
ObtenirTarifUnitaire = 0#
End Select
End FunctionFacture Macro.xlsm

**Philippe Tulliez** · 22/05/2023, 15h08

Bonjour,
Vous avez posé la même question dans cette discussion Besoin d'une Correction de la MACRO de mon fichier de facturation
Y a t'il un élément nouveau ou différent ?

**NOSLIB** · 22/05/2023, 15h57

Bonjour ,

Le seul nouveau élément est il possible après avoir resolu les differents problèmes rencontrés(mise à jour automatique , les arrondis et affichage du tarif unitaire) dans ma macro de créer une nouvelle macro pour l'exportation en fichier pdf de la facture initial.

Merci

**Philippe Tulliez** · 22/05/2023, 16h28

Bonjour,
Oui, bien entendu.
Il est même préférable d'avoir une procédure dédiée pour exporter la ou les feuilles excel au format pdf.
La ligne ci-dessous peut faire ce travail où obj peut être une variable objet de type Workbook ou Worksheet ou Object (ce qui permet de l'utiliser indifféremment pour un classeur ou pour une feuille) et FullName est une variable de type String devant contenir le nom du fichier ainsi que le chemin complet où sauver le fichier

Code :

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

obj.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName

Exemple 1 où la variable obj, de type Object, est une feuille

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub t()
  Dim obj As Object
  Dim FullName As String
  With ThisWorkbook
    Set obj = .Worksheets("Devis") ' ActiveWorkbook
    FullName = .Path & "\230522 - Devis Client 2.Pdf"
  End With
  obj.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName
  Set obj = Nothing
End Sub

Exemple 2 où la variable obj, de type Object, est un Classeur

Code :

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

1
2
3
4
5
6
7
8
Sub t()
  Dim obj As Object
  Dim FullName As String
  Set obj = Workbooks("Commande_Devis.xlsm")
  FullName = ThisWorkbook.Path & "\230522 - Devis Client 3.Pdf"
  obj.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName
  Set obj = Nothing
End Sub

**NOSLIB** · 22/05/2023, 17h08

J'ai essayé cette macro mais elle ne passe pas ou dois je créer un bouton spécial pour l'exportation en Pdf.
Deuxièmement mon problème persiste toujours au niveau de la mise à jour automatique des données , de l'affichage des données arrondi et le tarif unitaire.

Sub numeroFacture()

Dim numeroFacture As Long

' Remplacer "Mise à Fob" par le nom de votre feuille de travail
With ThisWorkbook.Sheets("Mise à Fob")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

If lastRow > 1 Then
numeroFacture = 1
Else
numeroFacture = 0
End If

.Cells(2, "C").Value = numeroFacture
End With

MiseAJourInfos
CalculerMontantFacture

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Mise à Fob") ' Remplacez "Mise à Fob" par le nom de votre feuille de travail

' Vérifier si le changement a eu lieu dans la plage des poids des marchandises (colonne D)
If Not Intersect(Target, ws.Range("D20

100")) Is Nothing Then
' Mise à jour du poids total arrondi (cellule E102) avec la somme des poids des marchandises arrondie à la tonne supérieure
ws.Range("E102").Value = Application.WorksheetFunction.Ceiling(Application.WorksheetFunction.Sum(ws.Range("D20

100")), 1)
CalculerMontantFacture ' Recalculer le montant de la facture après la mise à jour du poids total
End If

' Vérifier si le changement a eu lieu dans la cellule C9
If Target.Address = "$C$9" Then
MiseAJourInfos
CalculerMontantFacture ' Recalculer le montant de la facture après la mise à jour du type d'opération
End If
End Sub

Sub MiseAJourInfos()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Mise à Fob")

Dim nomSite As String
nomSite = ws.Cells(2, "C").Value

Select Case nomSite
Case "MAERSK SP0"
ws.Cells(4, "C").Value = "CI01MLOP64"
ws.Cells(5, "C").Value = "CI010110"
Case "GMCI"
ws.Cells(4, "C").Value = "CI01MLOP69"
ws.Cells(5, "C").Value = "CI010115"
Case "SACC/ETMD"
ws.Cells(4, "C").Value = "CI01MLOPLS"
ws.Cells(5, "C").Value = "CI010116"
Case "SITAPA"
ws.Cells(4, "C").Value = "CI01MLOP68"
ws.Cells(5, "C").Value = "CI010114"
Case "IROKOTARASNCI"
ws.Cells(4, "C").Value = "CI01MLOPL2"
ws.Cells(5, "C").Value = "CI010119"
Case Else
ws.Cells(4, "C").Value = ""
ws.Cells(5, "C").Value = ""
End Select

Dim nbMarchandises As Double
nbMarchandises = Application.WorksheetFunction.CountA(ws.Range("C20:C100"))
ws.Cells(10, "C").Value = nbMarchandises

Dim typeOperation As String
typeOperation = ws.Cells(9, "C").Value

Select Case typeOperation
Case "Vrac"
ws.Cells(11, "C").Value = "20'"
Case "Sac"
ws.Cells(11, "C").Value = "40'"
Case "Conventionnel"
ws.Cells(11, "C").Value = "0"
End Select
End Sub
Sub CalculerMontantFacture()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Mise à Fob")

' Récupérer le poids total à facturer (cellule D102)
Dim poidsTotal As Double
poidsTotal = Application.WorksheetFunction.Ceiling(Application.WorksheetFunction.Sum(ws.Range("D20

101")), 1) / 1000
ws.Cells(102, "D").Value = poidsTotal

' Récupérer le nom du client sélectionné
Dim nomClient As String
nomClient = ws.Cells(6, "C").Value

' Récupérer le type de prestation (cellule C13)
Dim typePrestation As String
typePrestation = ws.Cells(13, "C").Value

' Générer le tarif unitaire en fonction du nom du client et de sa prestation
Dim tarifUnitaire As Double
tarifUnitaire = ObtenirTarifUnitaire(nomClient, typePrestation)

' Placer le tarif unitaire dans la cellule F102
ws.Cells(102, "F").Value = tarifUnitaire

' Calculer le montant total à facturer (cellule G102)
Dim montantTotal As Double
montantTotal = poidsTotal * tarifUnitaire
ws.Cells(102, "G").Value = montantTotal
End Sub

Function ObtenirTarifUnitaire(ByVal nomClient As String, ByVal typePrestation As String) As Double
' Insérez ici votre logique pour obtenir le tarif unitaire en fonction du nom du client et de sa prestation
' Par exemple, vous pouvez utiliser une table de correspondance ou une requête à une base de données
' Pour cet exemple, je vais simplement renvoyer un tarif unitaire fixe pour illustrer le concept

Select Case nomClient
Case "AFRICA SOURCING"
Select Case typePrestation
Case "Vrac"
ObtenirTarifUnitaire = 33000 ' Tarif unitaire pour le client 1 en cas de prestation Vrac
Case "Sac"
ObtenirTarifUnitaire = 31500 ' Tarif unitaire pour le client 1 en cas de prestation Sac
Case "Conventionnel"
ObtenirTarifUnitaire = 20500 ' Tarif unitaire pour le client 1 en cas de prestation Conventionnel
End Select
Case "SOCAGC"
Select Case typePrestation
Case "Vrac"
ObtenirTarifUnitaire = 31500 ' Tarif unitaire pour le client 2 en cas de prestation Vrac
Case "Sac"
ObtenirTarifUnitaire = 30000 ' Tarif unitaire pour le client 2 en cas de prestation Sac
Case "Conventionnel"
ObtenirTarifUnitaire = 19500 ' Tarif unitaire pour le client 2 en cas de prestation Conventionnel
End Select
Case Else
ObtenirTarifUnitaire = 0#
End Select
End Function

Sub t()
Dim obj As Object
Dim FullName As String
With ThisWorkbook
Set obj = .Worksheets("Devis") ' ActiveWorkbook
FullName = .Path & "\230522 - Devis Client 2.Pdf"
End With
obj.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName
Set obj = Nothing
End Sub

**Philippe Tulliez** · 22/05/2023, 17h37

Bonjour,

J'ai essayé cette macro mais elle ne passe pas ou dois je créer un bouton spécial pour l'exportation en Pdf.

Je teste toutes les procédures que je publie mais avez-vous modifié le nom des constantes que j'ai utilisé ?
La procédure doit être placée dans un module standard.

Il serait préférable de poser plusieurs questions sur le forum avec chaque fois une partie de votre problématique sinon vous nous obligez à lire l'ensemble de votre code pour tenter de vous aider.

Pour moi, il n'y a aucune raison d'utiliser le VBA pour chercher un tarif. Les fonctions de recherche d'Excel (telles que RECHERCHEV, RECHERCHEX, INDEX + EQUIV) permettent de faire cela sans aucun problème

Correction de ma macro de facturation

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager