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

[lumzy]

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 :



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


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!

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @lumzy

Un exemple de code qui t'affiche le contenu de ta fiche (pour le #1 la ligne du bouton est la 30, pour le #2 la 35 etc ...)
Affecte cette macro à tes boutons (des rectangles en fait) pour vérifier puis adapte ton code.

Sub lgnCaller()
   
     Dim Nom_Btn$, t_Item, t_Type, t_Auteur, t_Titre, t_Description
     Dim Sh As Worksheet, TL_Cell As Range, lgn As Long
   
     t = Application.Caller
     Set Sh = ActiveSheet
     TL_Cell LaCell = Sh.Shapes.Range(t).Item(1).TopLeftCell
     lgn = bt.Row
     With Sh
          t_Item = .Cells(lgn - 1, 2).Value
          t_Type = .Cells(lgn + 1, 2).Value
          t_Auteur = .Cells(lgn + 1, 3).Value
          t_Titre = .Cells(lgn + 1, 5).Value
          t_Description = .Cells(lgn + 3, 2).Value
     End With
     MsgBox t_Item & Chr(9) & t_Type & Chr(10) & Chr(10) & t_Auteur & Chr(10) & Chr(10) & t_Titre & Chr(10) & Chr(10) & t_Description
   
End Sub

A bientôt

 

[AtTheOne]

Bonjour @lumzy ,
Tu es en pause, ou tu profites de tous ces jours fériés pour prendre des vacances ? ☀️🏕️
Ce serait bien de réagir aux réponses apportées non ? 😜
A bientôt