Mathieu35190
XLDnaute Nouveau
Bonjour
Je rencontre une petite difficulté d'ans l'exécution d'une Macro.
Pour info la plus grosse partie du code je l'ai récupérée. Elle n'est pas exactement comme je la voudrais évidement.
C'est une macro pour gérer des cartes de fidélités
J'ai une première page avec ma liste de client et un bouton dans lequel j'ajoute les dépenses qu'il à réalisés
j'ai le montant de référence qui me permet de déclencher un message pour m'informer que le client à atteint sa remise de 10€
sur la seconde page j'ai la liste des dépenses de tous mes clients dans un tableau
mon problème est que quand j'applique la macro j'ai bien la première ligne qui s'ajoute a mon tableau mais la seconde (le reste) s'inscrit toujours en dessous du tableau ce qui me ruine mes formule ensuite quand je reprends les données pour autre chose
voici le sc VBA en question:
Quelqu'un serait-il m'expliquer pourquoi ma première entrée ajoute bien une ligne a mon tableau mais pas la seconde?
Merci d'avance pour votre aide
Cordialement
Je rencontre une petite difficulté d'ans l'exécution d'une Macro.
Pour info la plus grosse partie du code je l'ai récupérée. Elle n'est pas exactement comme je la voudrais évidement.
C'est une macro pour gérer des cartes de fidélités
J'ai une première page avec ma liste de client et un bouton dans lequel j'ajoute les dépenses qu'il à réalisés
j'ai le montant de référence qui me permet de déclencher un message pour m'informer que le client à atteint sa remise de 10€
sur la seconde page j'ai la liste des dépenses de tous mes clients dans un tableau
mon problème est que quand j'applique la macro j'ai bien la première ligne qui s'ajoute a mon tableau mais la seconde (le reste) s'inscrit toujours en dessous du tableau ce qui me ruine mes formule ensuite quand je reprends les données pour autre chose
voici le sc VBA en question:
VB:
Sub AjoutAchat()
Dim NbFois As Integer, NbAvtR As Integer
Dim DLigA As Long, IdClt As String, Lig As Long
Dim MaForm As String, Rng1 As String, Rng2 As String, Rng3 As String
Dim TotalFois As Integer
' Initialiser les variables
LigSel = Selection.Row
TotalFois = 0
NbAvtR = Sheets("BdDClt").Range("NbAchtAvtR").Value
'
' Tester le numéro de ligne
If LigSel <= 2 Then
' Si ligne d'entête on prévient et on sort
MsgBox "Merci de sélectionner une ligne de client et non d'entête", vbInformation, "ATTENTION .."
Exit Sub
End If
'
' Mémoriser l'IdClient
IdClt = Range("A" & LigSel).Value
'
' Tester si une ligne avec un nom de client a été sélectionnée
If Len(Range("B" & LigSel).Value) = 0 Then
' Si aucun nom de client sur la ligne
MsgBox "Merci de sélectionner une ligne avec un nom de client", vbInformation, "ATTENTION ..."
Exit Sub
End If
'
' Si OK, afficher l'Userform pour la saisie
UsF_Achat.Show
'
' Définir la feuille qui reçoit les achats
Set ShtA = Worksheets("Achats")
' Calculer le nombre d'€ dépensé
DLigA = ShtA.Range("A" & Rows.Count).End(xlUp).Row
Rng1 = "(" & ShtA.Name & "!A2:A" & DLigA & "=""" & IdClt & """)" ' Id Client
Rng2 = "(" & ShtA.Name & "!E2:E" & DLigA & "="""")" ' Remise non effectuée
Rng3 = "(" & ShtA.Name & "!D2:D" & DLigA & ")" ' Nombre de €
MaForm = Rng1 & "*" & Rng2 & "*" & Rng3
On Error Resume Next
NbFois = 0: NbFois = Application.Evaluate("SUMPRODUCT(" & MaForm & ")")
On Error GoTo 0
' Si le nombre d € que le client a dépensé est inférieur à NbAchtAvtR
If NbFois >= NbAvtR Then
' Afficher le message
MsgBox "Le client à droit à 10€ de remise", vbInformation, "REMISE ACCORDEE"
' Pour chaque ligne de la feuille Achat
For Lig = 2 To DLigA
' Si l'IdClient est le bon
If ShtA.Range("A" & Lig).Value = IdClt Then
' Si la colonne de [Remise faite] est vide
If ShtA.Range("E" & Lig).Value = "" Then
' On fait l'addition du nombre de d €
TotalFois = TotalFois + ShtA.Range("D" & Lig).Value
' On vérifie que le total ne dépasse pas le NbAchtAvtR
If TotalFois > NbAvtR Then
' Sinon on recopie la ligne en dessous
ShtA.Rows(Lig).Copy
ShtA.Rows(Lig + 1).Insert shift:=xlDown
' On inscrit le nombre d € pour arriver à NbAchtAvtR sur la première ligne
ShtA.Range("D" & Lig).Value = ShtA.Range("D" & Lig).Value - (TotalFois - NbAvtR)
' On inscrit le nombre d € restant pour la prochaine fois sur la ligne suivante
ShtA.Range("D" & Lig + 1).Value = TotalFois - NbAvtR
End If
' On complète
ShtA.Range("E" & Lig).Value = "OK"
End If
End If
Next Lig
End If
End SubQuelqu'un serait-il m'expliquer pourquoi ma première entrée ajoute bien une ligne a mon tableau mais pas la seconde?
Merci d'avance pour votre aide
Cordialement
