Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Petit problème ajout ligne à un tableau

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:

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 Sub

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
 

Mathieu35190

XLDnaute Nouveau
 

Deadpool_CC

XLDnaute Accro
Bonjour,

Pourtant tu sembles être sur un tableau structuré ... son extension devrait être automatique ... !?!
Peut-être nous mettre un fichier d'exemple 'anonymisé' pour qu'on puisse tester en pas-à-pas ta macro (exécution via F8)
Sinon si tu remplit la dernière colonne du tableau par un 'en cours' par exemple, il se passe quoi ?
peut-être que la ligne alimentée en VBA n'étant pas complète excel n'étend pas le tableau ... là j'ai jamais testé !
 

chris

XLDnaute Barbatruc
Bonjour à tous

Utiliser un tableau Structuré et coder comme une plage est un non sens

La ligne d'en-tête est [NomTableau].Listobject.Range.Row

Il est inutile de mentionner l'onglet

On se réfère aux colonnes par leur nom

[NomTableau].Listobject.ListColumns("NomColonne") et à leur contenu
par
[NomTableau].Listobject.ListColumns("NomColonne").DatabodyRange

 

Mathieu35190

XLDnaute Nouveau
Bonjour

Merci #DeadPool_CC et #chris pour vos retour

malheureusement je ne comprends pas tout ce que tu me dis #chris je suis un Noob

Je vous joint mon fichier ainsi vous pouvez tester

Merci beaucoup pour votre aide

Cordialement
 

Pièces jointes

  • carte-de-fidelite JVAV.xlsm
    137.2 KB · Affichages: 6

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…