Fonction d'un bouton dynamique : déplacement de données d'un tableau

Question

Bonjour à tous ! et merci de prendre le temps de me lire..

Voici mon problème : je cherche à attribuer une fonction à un bouton créé dynamiquement à l'aide d'un module de classe, mais j'ai du mal à formuler mon mon code.

Contexte : Dans mon fichier qui est un répertoire de clients, les dates des dernières commandes passées sont enregistrées. J'ai créé un petit formulaire dynamique qui permet à l'utilisateur de visualiser ces données pour le client sélectionné. Dans ce formulaire dynamique, on à donc les dates des anciennes commandes, et un bouton "Supprimer". Ce bouton est dynamique, et doit permettre à l'utilisateur de supprimer une date de commande (en cas de mauvaise saisie par exemple).
Voici la procédure avec laquelle les boutons sont créés, que j'ai repris depuis un autre forum :

            ' création du BOUTON "Supprimer", à condition qu'une date de commande puisse lui être attribué
            If Cells(ligne, colonne + I * 2).Value <> "" Then                    'si une commande a été enregistrée
            Set Suppr = UserForm3.Controls.Add("Forms.CommandButton.1")           
            With Suppr
                .Left = 210
                .Top = 31 + ((I - 1) * 18)
                .Width = 54
                .Height = 18
                .Name = "Supprimer" & I            'nom unique pour chaque formulaire, avec I variable
                .Caption = "Supprimer"
                .Font.Bold = True
                .Font.Size = 8

                Set Cl = New Classe1
                Set Cl.Bouton = Suppr
                Collect.Add Cl
            End With

Dans ma base de données, les dates de commandes sont inscrites les unes après les autres dans ces cellules différentes, mais les cellules seront masquées à l'utilisateur.

Lorsque je clique sur un de ces boutons pour supprimer une date de commande, j'aimerais que la cellule qui contient la date soit vidée, puis que les autres dates soient déplacées d'un rang vers la gauche pour ne pas laisser de trou. Voici le module de classe réalisé, aussi inspiré d'un post :

Option Explicit

Public WithEvents Bouton As MSForms.CommandButton

Private Sub Bouton_Click()

Dim Ctrl As control
Dim I As Integer

Dim ligne As Long
Dim colonne As Long
Dim sh As Shape
Set sh = ActiveSheet.Shapes(Application.Caller)  'recupere le bouton cliqué
ligne = sh.TopLeftCell.Row                       'N° ligne du bouton
colonne = sh.TopLeftCell.Column                  'N° colonne du bouton

For Each Ctrl In UserForm3.Controls

    If Ctrl.Name = "Supprimer" & I Then

For I = 1 To 12

    'le bouton supprime le passage associé au bouton
    Cells(ligne, (I * 2) + 7).Value = ""        'date de passage = 0
    Cells(ligne, (I * 2) + 8).Value = ""        'montant du passage = 0

    'et les anciennes dates sont déplacées
    'méthode de déplacement des données antérieures (conditionnelle)
    'si la case à droite de Cells(ligne, I) n'est pas vide, alors
    'caseI+1 = caseI
        'si la case I+2 n'est pas vide, alors
        'caseI+2 = caseI+1
            '...

    'et déplace les dates et les montants des précédentes commandes :
    If I < 12 And Cells(ligne, ((I + 1) * 2) + 7).Value <> "" Then
    Cells(ligne, ((I + 1) * 2) + 7).Value = Cells(ligne, (I * 2) + 7).Value
    Cells(ligne, ((I + 1) * 2) + 8).Value = Cells(ligne, (I * 2) + 8).Value
        If Cells(ligne, ((I + 2) * 2) + 7).Value <> "" Then
        Cells(ligne, ((I + 2) * 2) + 7).Value = Cells(ligne, ((I + 1) * 2) + 7).Value
        Cells(ligne, ((I + 2) * 2) + 8).Value = Cells(ligne, ((I + 1) * 2) + 8).Value
            If Cells(ligne, ((I + 3) * 2) + 7).Value Then
            Cells(ligne, ((I + 3) * 2) + 7).Value = Cells(ligne, ((I + 2) * 2) + 7).Value
            Cells(ligne, ((I + 3) * 2) + 8).Value = Cells(ligne, ((I + 2) * 2) + 8).Value
                '...
                '...
            End If
        End If
    End If

Next I
End If
Next

Unload UserForm3
Cells(ligne, 6).Select

End Sub

Mais cela ne fonctionne pas bien, entre autres parce que "i" ne change pas de valeur.. Aussi, les déplacements des données ne donnent pas résultat attendu

Je vous laisse mon fichier pour mieux comprendre.

Merci par avance pour vos conseils, je vais continuer à chercher de mon côté aussi :)

9fidelisation-clients.xlsm (134.35 Ko)

ric · Accepted Answer

Voici le code du module de Classe ... Private Sub Bouton_Click() Dim Ctrl As control Dim ligne As Long Dim col As Long Dim sh As Shape Set sh = ActiveSheet.Shapes(Application.Caller) 'recupere le bouton cliqué col = CInt(Right(Bouton.Name, Len(Bouton.Name) - 9)) ligne = sh.TopLeftCell.Row ' - 7 'N° ligne du bouton 'le bouton supprime le passage et le montant associé au bouton Range(Cells(ligne, 8).Offset(0, (col * 2) - 1 + 2), Cells(ligne, 8).Offset(0, 24)).Copy Range(Cells(ligne, 8).Offset(0, (col * 2) - 1), Cells(ligne, 8).Offset(0, 22)) Range(Cells(ligne, "AE"), Cells(ligne, "AF")).ClearContents Unload UserForm3 Cells(ligne, 6).Select End Sub ric...

ric · Answer

Que penses-tu de l'idée de l'identification ainsi ?? Il reste des bogues avec l'effacement des passages (si ce n'est pas le dernier) ... mais, je crois que tu peux corriger cela &gt; sinon ... reviens dire où tu en es ... Private Sub Bouton_Click() Dim Ctrl As control Dim J As Integer Dim ligne As Long Dim colonne As Long Dim sh As Shape Set sh = ActiveSheet.Shapes(Application.Caller) 'recupere le bouton cliqué ligne = sh.TopLeftCell.Row 'N° ligne du bouton colonne = sh.TopLeftCell.Column 'N° colonne du bouton J = I I = Right(Bouton.Name, Len(Bouton.Name) - 9) '' &lt;&lt; identifier le bouton cliqué 'le bouton supprime le passage et le montant associé au bouton Cells(ligne, (I * 2) + 7).Value = "" 'date de passage = 0 Cells(ligne, (I * 2) + 8).Value = "" 'montant du passage = 0 'méthode de déplacement des données antérieures (conditionnelle) 'si la case à droite de Cells(ligne, I) n'est pas vide, alors 'caseI+1 = caseI 'si la case I+2 n'est pas vide, alors 'caseI+2 = caseI+1 '... '... 'et déplace les passages et montants précedents If I &lt; 12 And Cells(ligne, ((I + 1) * 2) + 7).Value &lt;&gt; "" Then Cells(ligne, ((I + 1) * 2) + 7).Value = Cells(ligne, (I * 2) + 7).Value Cells(ligne, ((I + 1) * 2) + 8).Value = Cells(ligne, (I * 2) + 8).Value If Cells(ligne, ((I + 2) * 2) + 7).Value &lt;&gt; "" Then Cells(ligne, ((I + 2) * 2) + 7).Value = Cells(ligne, ((I + 1) * 2) + 7).Value Cells(ligne, ((I + 2) * 2) + 8).Value = Cells(ligne, ((I + 1) * 2) + 8).Value If Cells(ligne, ((I + 3) * 2) + 7).Value Then Cells(ligne, ((I + 3) * 2) + 7).Value = Cells(ligne, ((I + 2) * 2) + 7).Value Cells(ligne, ((I + 3) * 2) + 8).Value = Cells(ligne, ((I + 2) * 2) + 8).Value If Cells(ligne, ((I + 4) * 2) + 7).Value Then Cells(ligne, ((I + 4) * 2) + 7).Value = Cells(ligne, ((I + 3) * 2) + 7).Value Cells(ligne, ((I + 4) * 2) + 8).Value = Cells(ligne, ((I + 3) * 2) + 8).Value If Cells(ligne, ((I + 5) * 2) + 7).Value Then Cells(ligne, ((I + 5) * 2) + 7).Value = Cells(ligne, ((I + 4) * 2) + 7).Value Cells(ligne, ((I + 5) * 2) + 8).Value = Cells(ligne, ((I + 4) * 2) + 8).Value If Cells(ligne, ((I + 6) * 2) + 7).Value Then Cells(ligne, ((I + 6) * 2) + 7).Value = Cells(ligne, ((I + 5) * 2) + 7).Value Cells(ligne, ((I + 6) * 2) + 8).Value = Cells(ligne, ((I + 5) * 2) + 8).Value If Cells(ligne, ((I + 7) * 2) + 7).Value Then Cells(ligne, ((I + 7) * 2) + 7).Value = Cells(ligne, ((I + 6) * 2) + 7).Value Cells(ligne, ((I + 7) * 2) + 8).Value = Cells(ligne, ((I + 6) * 2) + 8).Value If Cells(ligne, ((I + 8) * 2) + 7).Value Then Cells(ligne, ((I + 8) * 2) + 7).Value = Cells(ligne, ((I + 7) * 2) + 7).Value Cells(ligne, ((I + 8) * 2) + 8).Value = Cells(ligne, ((I + 7) * 2) + 8).Value If Cells(ligne, ((I + 9) * 2) + 7).Value Then Cells(ligne, ((I + 9) * 2) + 7).Value = Cells(ligne, ((I + 8) * 2) + 7).Value Cells(ligne, ((I + 9) * 2) + 8).Value = Cells(ligne, ((I + 8) * 2) + 8).Value If Cells(ligne, ((I + 10) * 2) + 7).Value Then Cells(ligne, ((I + 10) * 2) + 7).Value = Cells(ligne, ((I + 9) * 2) + 7).Value Cells(ligne, ((I + 10) * 2) + 8).Value = Cells(ligne, ((I + 9) * 2) + 8).Value If Cells(ligne, ((I + 11) * 2) + 7).Value Then Cells(ligne, ((I + 11) * 2) + 7).Value = Cells(ligne, ((I + 10) * 2) + 7).Value Cells(ligne, ((I + 11) * 2) + 8).Value = Cells(ligne, ((I + 10) * 2) + 8).Value If Cells(ligne, ((I + 12) * 2) + 7).Value Then Cells(ligne, ((I + 12) * 2) + 7).Value = Cells(ligne, ((I + 11) * 2) + 7).Value Cells(ligne, ((I + 12) * 2) + 8).Value = Cells(ligne, ((I + 11) * 2) + 8).Value If Cells(ligne, ((I + 13) * 2) + 7).Value Then Cells(ligne, ((I + 13) * 2) + 7).Value = Cells(ligne, ((I + 12) * 2) + 7).Value Cells(ligne, ((I + 13) * 2) + 8).Value = Cells(ligne, ((I + 12) * 2) + 8).Value If Cells(ligne, ((I + 14) * 2) + 7).Value Then Cells(ligne, ((I + 14) * 2) + 7).Value = Cells(ligne, ((I + 13) * 2) + 7).Value Cells(ligne, ((I + 14) * 2) + 8).Value = Cells(ligne, ((I + 13) * 2) + 8).Value End If End If End If End If End If End If End If End If End If End If End If End If End If End If Unload UserForm3 Cells(ligne, 6).Select End Sub ric...

ric · Answer

La variable J est là pour faire joli &gt;&gt; Ce n'est pas cela &gt; j'étais parti sur une autre approche qui n'était pas gagnante &gt; tu peux effacer cette joli variable J ... Pour le reste du code de cette macro, je n'ai testé que le dernier passage pour une personne ... Je veux bien regarder cela ... Par contre, j'aurais une autre approche &gt; supposons que l'on veuille supprimer le 2e passage &gt; je prendrais le bloc 3e passage jusqu'à 12e que je copierais dans le 2e &gt; puis, j'effacerais le 12e &gt; 1 et 2 ... simple et pas difficile à faire ... Je te reviens ... ric...

ric · Answer

Ric...