XL 2019 Afficher une lettre dans des cellules avec un bouton

[Yann71]

Bonjour le Forum,
Après uen journée de recherche, et n'ayant pu trouver les infos recherchées je viens vers vous pour trouver de l'aide. J'aimerai qu'avec un bouton je puisse remplir par exemple par la lettre T un groupe de cellules que je sélectionne avec la souris, et un 2ème bouton qui as la même fonction que le 1er mais en affichant la lettre A. Pour finir qu'un 3ème bouton, lui puisse vider les cellules que j'aurai sélectionné.

 

[mapomme]

Bonsoir @Yann71 ,

Essayez :

Sub Bouton1_Cliquer()
   Selection.Value = "T"
End Sub

Sub Bouton2_Cliquer()
   Selection.Value = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   For Each xcell In Selection
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub

 

[juvaxe]

Bonsoir Yann71, bonsoir mapomme

Je n'ai pas compris la même chose que mapomme : j'ai compris que Yann71 ne sélectionne pas l'ensemble des cellules concernées par la mise en place d'une même lettre dans chacune d'entre elles, mais qu'il sélectionne seulement une cellule qui contient une formule de calcul et qu'il souhaite que chacune des cellules qui se trouvent dans cette formule reçoive la même lettre en fin de macro.

Mon VBA est plutôt basic, il y aura peut-être d'autres réponses ...

J'ai seulement réalisé la première option.

Pour la deuxième option, si ma compréhension est bien la bonne tu devrais pouvoir t'en sortir en recopiant ma proposition.

Pour la troisième option dans laquelle tu sélectionne effectivement l'ensemble de la zone concernée, tu devrais pouvoir t'en sortir en reprenant le code proposé par mapomme.


Bonne réception

 

[juvaxe]

Avec la pièce jointe ce sera mieux ...

 

[mapomme]

Bonsoir @juvaxe ,

Je n'ai pas compris la même chose que mapomme : j'ai compris que Yann71 ne sélectionne pas l'ensemble des cellules concernées par la mise en place d'une même lettre dans chacune d'entre elles, mais qu'il sélectionne seulement une cellule qui contient une formule de calcul et qu'il souhaite que chacune des cellules qui se trouvent dans cette formule reçoive la même lettre en fin de macro.

Dans ce cas, la macro peut s'écrire tout aussi simplement.
La propriété "Precedents" renvoie le range de tous les antécédents d'une cellule et cela même si la formule est complexe (et donc ne permet pas de retrouver les antécédents par un simple Split(...) )

La propriété"Precedents" ne peut cependant repérer que les références évidentes et saisies comme telles : =Indirect("L" & 6) n'a pas de "Precedents".

Pour tester, sélectionner une formule en AL19 ou AL20 puis cliquer sur le bouton "T" ou le bouton "A".

Sub Bouton1_Cliquer()
   On Error Resume Next
   Selection.Precedents = "T"
End Sub

Sub Bouton2_Cliquer()
   On Error Resume Next
   Selection.Precedents = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   For Each xcell In Selection
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub

 

[Yann71]

Bonsoir @Yann71 ,

Essayez :

Sub Bouton1_Cliquer()
   Selection.Value = "T"
End Sub

Sub Bouton2_Cliquer()
   Selection.Value = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   For Each xcell In Selection
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub

Bonjour le Forum bonjour le fil. Je te remercie c'est exactement ce que je recherchais, je vais pouvoir avancer dans mon projet. Une petite question, ton fichier permet de rempir n'importe ou dasn la feuille, comment puis-je limiter le remplissage, exemple uniquement de A1:H50 et de A60:H100. Bonne journée et merci encore pour ton aide.

 

[Yann71]

Avec la pièce jointe ce sera mieux ...

Bonjour juvaxe, merci pour ton intervention. Il est possible que ma demande aie été un peut difficile à saisir ou que je ne me suis pas exprimé comme il le fallait, mais mapomme à proposé une fichier qui correspond exactement à ce que je recherchai. Je te remercie encore pour ton aide. Passe une bonne journée.

 

[juvaxe]

Bonjour

L'utilisation de "Precedents" est bien plus immédiate et conviviale. Inutile de refaire ce que VBA fait déjà, bien mieux, pour ses utilisateurs.

Je suis, encore une fois, interdit devant les possibilités sans fin de VBA et de la connaissance que des membres de ce forum en ont.

Cdt

 

[mapomme]

L'utilisation de "Precedents" est bien plus immédiate et conviviale. Inutile de refaire ce que VBA fait déjà, bien mieux, pour ses utilisateurs.

Re @juvaxe ,
Il y a des propriétés qu'on utilise si peu souvent qu'on les oublie. C'est vous et votre compréhension de la question qui m'a fait me souvenir de cette propriété.

 

[mapomme]

Bonjour @Yann71 ,

Une petite question, ton fichier permet de rempir n'importe ou dasn la feuille, comment puis-je limiter le remplissage, exemple uniquement de A1:H50 et de A60:H100. Bonne journée et merci encore pour ton aide.

Voici la version v3 qui se limite aux plages a1:h50 et a60:h100 que se soit pour y placer les "T" ou "A" ou bien pour les effacer.

Sub Bouton1_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "T"
End Sub

Sub Bouton2_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   On Error Resume Next: Application.ScreenUpdating = False
   For Each xcell In Intersect(Range("a1:h50,a60:h100"), Selection)
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub

 

[Yann71]

Bonjour @Yann71 ,



Voici la version v3 qui se limite aux plages a1:h50 et a60:h100 que se soit pour y placer les "T" ou "A" ou bien pour les effacer.

Sub Bouton1_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "T"
End Sub

Sub Bouton2_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   On Error Resume Next: Application.ScreenUpdating = False
   For Each xcell In Intersect(Range("a1:h50,a60:h100"), Selection)
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub
[/COD
[/QUOTE]

 

[Yann71]

Bonjour @Yann71 ,



Voici la version v3 qui se limite aux plages a1:h50 et a60:h100 que se soit pour y placer les "T" ou "A" ou bien pour les effacer.

Sub Bouton1_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "T"
End Sub

Sub Bouton2_Cliquer()
   On Error Resume Next
   Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "A"
End Sub

Sub Bouton3_Cliquer()
Dim xcell
   On Error Resume Next: Application.ScreenUpdating = False
   For Each xcell In Intersect(Range("a1:h50,a60:h100"), Selection)
      If xcell = "A" Or xcell = "T" Then xcell.ClearContents
   Next xcell
End Sub

Bonjour mapomme, bonjourle fil.
Je viens d'essayer ton fichier, mais rien ne fonctionne

 

[mapomme]

Je viens d'essayer ton fichier, mais rien ne fonctionne

Chez moi, ça fonctionne.

nota : supprimez le massage #11 qui ne sert à rien...

 

[Yann71]

Chez moi, ça fonctionne.

nota : supprimez le massage #11 qui ne sert à rien...

J'ai à nouveau téléchargé ton fichier mais lorsque je sélectionne certaien cellule dans la plage de sélection rien ne s'affiche. Petite question qu'est ce donc les formules dans les cellules AL19:AL21.
comment puis-je supprimer le message 11

Chez moi, ça fonctionne.

nota : supprimez le massage #11 qui ne sert à rien...

Lorsque je sélectionne certaines cellules et que je clic sur "T" il me met une erreur ( erreur d'exécussion 1004 pas de cellules correspondantes ) et me souligne cette ligne de code en jaune : Intersect(Range("a1:h50,a60:h100"), Selection.Precedents) = "T"
pourtant j'ai sélectionné B3:C6.

 

[mapomme]

Re,
Il faudrait le fichier en cause...