VBA - Aide Compteur & Textbox

  • Initiateur de la discussion Initiateur de la discussion Spinzi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Spinzi

XLDnaute Impliqué
Bonjour à toutes et à tous,

je vous explique mon problème : j'ai besoin d'incrémenter un textbox de +1 ou -1 grâce à 2 shapes ("-" et "+").
Il faut que ce mécanisme fonctionne sur plus de 100 lignes (aléatoire).
Dans le fichier exemple, vous trouverez :
_des textboxs des lignes 11 à 20 liées à la colonne Q (nommées textbox1 à textbox8)
_2 shapes de chaque coté des textboxs ("-" & "+", nommées shp_M_1 à shp_M_8 & shp_P_1 à shp_P_8)

J'ai réussi à utiliser mon compteur correctement, mais je me retrouve obligé de créer une macro par ligne et je souhaiterai automatiser ce traitement.
J'ai l'intuition qu'il faudrait ramener l'adresse des shapes pour incrémenter correctement les textbox.

Voici mes 2 macro actuellement :
VB:
Sub Incremente()
Range("Q11") = Range("Q11") + 1
End Sub

Sub Desincremente()
Range("Q11") = Range("Q11") - 1
End Sub

Et mes tests qui ne fonctionnent pas correctement :
Code:
Sub CompteurPlus()
For i = 11 To 20
    Range("Q" & i) = Range("Q" & i) + 1
Next i
End Sub

Sub CompteurMoins()
For i = 11 To 20
    Range("Q" & i) = Range("Q" & i) - 1
Next i
End Sub

Merci d'avance de votre aide
Spinzi
 

Pièces jointes

Solution
Bonjour,

En pièce jointe, les deux macros ci-dessous ce base sur le nom des shapes et leur position dans la feuille (.TopLefCell) pour retrouver le numéro de ligne

VB:
Sub Incremente()
    If TypeName(Application.Caller) <> "String" Then Exit Sub
    If Left(Application.Caller, 5) <> "shp_P" Then Exit Sub
    With Range("Q" & Shapes(Application.Caller).TopLeftCell.Row)
        .Value = .Value + 1
    End With
End Sub
Sub Desincremente()
    If TypeName(Application.Caller) <> "String" Then Exit Sub
    If Left(Application.Caller, 5) <> "shp_M" Then Exit Sub
    With Range("Q" & Shapes(Application.Caller).TopLeftCell.Row)
        .Value = .Value - 1
    End With
End Sub

cordialement
Bonjour,

En pièce jointe, les deux macros ci-dessous ce base sur le nom des shapes et leur position dans la feuille (.TopLefCell) pour retrouver le numéro de ligne

VB:
Sub Incremente()
    If TypeName(Application.Caller) <> "String" Then Exit Sub
    If Left(Application.Caller, 5) <> "shp_P" Then Exit Sub
    With Range("Q" & Shapes(Application.Caller).TopLeftCell.Row)
        .Value = .Value + 1
    End With
End Sub
Sub Desincremente()
    If TypeName(Application.Caller) <> "String" Then Exit Sub
    If Left(Application.Caller, 5) <> "shp_M" Then Exit Sub
    With Range("Q" & Shapes(Application.Caller).TopLeftCell.Row)
        .Value = .Value - 1
    End With
End Sub

cordialement
 

Pièces jointes

Bonjour,

top c'est exactement ce que je souhaitais faire !
Merci beaucoup

2 petites questions :
_je ne comprends pas ce bout de code : TypeName(Application.Caller) <> "String"
_si je souhaite contrôler la saisie (valeur >=0 et valeur <> string), j'imbrique 2 SI ? Ou il y a une technique plus simple/rapide/jolie ?

Merci d'avance,
Spinzi
 
bonjour,

Vous avez toujours la possibilité de cliquer dans un mot clef de vba et ensuite d'appuyer sur F1 pour avoir l'aide.

Application.Caller renvoie des informations concernant la manière dont la macro a été appelée, soit un objet, soit une chaîne de caractères (String). Aide Microsoft - Application.Caller

Dans le cas qui nous concerne, on s'attend à ce que la macro soit appelée par un Shape, Application.Caller sera alors de Type 'String' et contiendra le nom du Shape cliqué pour appeler la macro.

Quant à la seconde question vous trouverez de nombreux exemples de codes sur le forum, et si éventuellement vous ne trouvez pas, créez un nouveau fil de discussion pour ça.
Indication : vos textboxes ne sont pas à traiter comme des 'Shapes' ce sont des contrôles MSForms.

Bonne journée
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
477
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
663
Réponses
7
Affichages
626
Réponses
7
Affichages
799
Réponses
5
Affichages
501
Réponses
0
Affichages
467
Retour