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 SubExtrait 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 SubLe 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 ligneAttention 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