Faire agir une macro en fonction de l'emplacement du bouton

Bonjour,

Voici la problématique avec laquelle je me bats depuis de nombreux jours sans parvenir à mes fins, malgré de très nombreuses recherches, vidéos, prompts et j'en passe

Je souhaite pouvoir créer une macro unique qui puisse être lancée depuis plusieurs boutons (formes ou boutons de formulaires, je ne sais pas ce qu'il y a de plus adapté), dont la position n'est pas connue à l'avance. Chaque bouton est positionné sur une fusion de cellules, mais toujours sur le même niveau (cf. images ci-après). L'objectif est donc de récupérer l'emplacement du bouton qui est cliqué afin de connaître la ligne sur laquelle il est positionné pour pouvoir réaliser l'action qui est écrite en deuxième partie de code (intégrer des données dans le tableau d'une autre feuille).

Voici le code qui fonctionne pour un seul bouton, car les lignes sont renseignées à l'avance, et donc l'action n'est pas "automatisée" :

Sub RECOPIE()

    If ActiveSheet.Range("B31").Value = "" Then
    MsgBox "Tous les champs ne sont pas remplis", vbExclamation
    Exit Sub
    End If

    If ActiveSheet.Range("C31").Value = "" Then
    MsgBox "Tous les champs ne sont pas remplis", vbExclamation
    Exit Sub
    End If

    If ActiveSheet.Range("E31").Value = "" Then
    MsgBox "Tous les champs ne sont pas remplis", vbExclamation
    Exit Sub
    End If

    If ActiveSheet.Range("B33").Value = "" Then
    MsgBox "Tous les champs ne sont pas remplis", vbExclamation
    Exit Sub
    End If

    DerniereLigne = Sheets("BDD RETEX").Range("B" & Rows.Count).End(xlUp).Row + 1
    Sheets("BDD RETEX").Range("B" & DerniereLigne).EntireRow.Insert
    Sheets("BDD RETEX").Range("C" & DerniereLigne).Value = ActiveSheet.Name
    Sheets("BDD RETEX").Range("D" & DerniereLigne).Value = ActiveSheet.Range("B31").Value
    Sheets("BDD RETEX").Range("E" & DerniereLigne).Value = ActiveSheet.Range("C31").Value
    Sheets("BDD RETEX").Range("F" & DerniereLigne).Value = ActiveSheet.Range("E31").Value
    Sheets("BDD RETEX").Range("G" & DerniereLigne).Value = ActiveSheet.Range("B33").Value

    MsgBox "L'élément a bien été intégré à la base de données RETEX"

End Sub

Extrait des feuilles concernées pour illustrer le propos :

capture

Le bouton en I32, que je souhaite généraliser à tous les boutons, me permet ce rendu :

capture

Pour faire simple, j'aimerais que les "31" après chaque lettre de colonne soit remplacé par le numéro de la ligne sur laquelle est positionné le bouton qui a été cliqué, et que le "33" soit égal à la cette ligne + 2.

J'ai donc tenté à plusieurs reprises, et voici le code actuel sur lequel je suis arrivé, mais qui ne fonctionne pas encore :

Sub BigBouton()

    Dim Bouton As Shape
    Dim CelluleBouton As Range
    Dim LigneBouton As Long

    ' Obtenir l'objet Shape du bouton 
    Set Bouton = Application.Caller
    ' Obtenir la cellule sous le bouton
    Set CelluleBouton = Bouton.TopLeftCell.Offset(1, 0)
    ' Extraire le numéro de ligne
    LigneBouton = CelluleBouton.Row 

    If ActiveSheet.Range("B" & LigneBouton).Value = "" Then
        MsgBox "Tous les champs ne sont pas remplis", vbExclamation
        Exit Sub
    End If

    If ActiveSheet.Range("C" & LigneBouton).Value = "" Then
        MsgBox "Tous les champs ne sont pas remplis", vbExclamation
        Exit Sub
    End If

    If ActiveSheet.Range("E" & LigneBouton).Value = "" Then
        MsgBox "Tous les champs ne sont pas remplis", vbExclamation
        Exit Sub
    End If

    If ActiveSheet.Range("B" & (LigneBouton + 2)).Value = "" Then
        MsgBox "Tous les champs ne sont pas remplis", vbExclamation
        Exit Sub
    End If

    DerniereLigne = Sheets("BDD RETEX").Range("B" & Rows.Count).End(xlUp).Row + 1
    Sheets("BDD RETEX").Range("B" & DerniereLigne).EntireRow.Insert

    Sheets("BDD RETEX").Range("C" & DerniereLigne).Value = ActiveSheet.Name
    Sheets("BDD RETEX").Range("D" & DerniereLigne).Value = ActiveSheet.Range("B" & LigneBouton).Value
    Sheets("BDD RETEX").Range("E" & DerniereLigne).Value = ActiveSheet.Range("C" & LigneBouton).Value
    Sheets("BDD RETEX").Range("F" & DerniereLigne).Value = ActiveSheet.Range("E" & LigneBouton).Value
    Sheets("BDD RETEX").Range("G" & DerniereLigne).Value = ActiveSheet.Range("B" & (LigneBouton + 2)).Value

    MsgBox "L'élément a bien été intégré à la base de données RETEX"

End Sub

Le coeur de mon problème se situe dans la façon de définir LigneBouton, que je n'arrive pas à maîtriser.

Dans l'espoir que quelqu'un m'arrive en aide, je vous transmets le fichier

Merci beaucoup!

Bonjour,

Pour faire simple tu aurais du utiliser des boutons ActiveX et non des boutons de Formulaire...

Regarde du coté de Shape.TopLectCell...

A+

Bonjour,

De ce que je vois il faut juste changer un peu le début:

    Set Bouton = Feuil1.Shapes(Application.Caller) ' Obtenir l'objet Shape du bouton
    Set CelluleBouton = Bouton.TopLeftCell ' Obtenir la cellule sous le bouton
    LigneBouton = CelluleBouton.Row + 1 ' Extraire le numéro de ligne

Attention car Application.Caller renvoie le nom de l'objet, et nom l'objet en lui même, on doit passer par Feuil1.Shapes(Application.Caller) pour obtenir la forme qui a ce nom et l'enregistrer dans la variable Bouton.

Ensuite j'ai ajusté les 2 autres lignes de code pour qu'on tombe sur la bonne ligne, pas besoin du offset, on peut juste prendre le numéro de la ligne et faire + 1

Magnifique, c'est exactement ce qu'il me fallait ! J'y étais presque ahah

Merci infiniment

Rechercher des sujets similaires à "agir macro fonction emplacement bouton"