[VBA] Personnaliser CommandBars("Cell")-Demande de conseils

[Staple1600]

Bonjour à tous


Dans le classeur ci-joint vous trouverez un descriptif détaillé
de ma demande.

Résumé:
Après la personnalisation du menu contextuel (en VBA)
comment effacer une Shape (en 1 clic)?

(+demande de conseils et/ou autre piste en vie de faciliter la saisie
dans une feuille)


PS: j'ai inactivé les macros (en ajoutant un apostrophe)

--> Pour ceux qui débutent en VBA
ATTENTION :Le code VBA modifie le menu contextuel d'Excel
(une fois que les macros seront décommentées )

En cas de problème:
Il y a une macro prévue pour réactiver le menu
Si vous n'êtes pas sûr de savoir réactiver le menu
n'utiliser pas ce classeur.

Aide supplémentaire ici: Comment personnaliser des menus et une barre de menus dans Excel

Bonne soirée et merci à tous ceux qui voudront bien s'attarder dans ce post.

A+


JM

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonsoir Stapple1600,

Pour répondre rapidement à la question a) et te permettre peut être de commencer à avancer, tu peux faire un tour ici.
En appliquant Test1 à chaque fois que tu crées un shape via ton menu et en remplaçant Test2 par :

Sub Test2()
NomGraph = Application.Caller
ActiveSheet.Shapes(NomGraph).Delete
End Sub

(Non testé)

Sinon, tu peux utiliser un module de classe...

Cordialement

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonsoir Spitnolan08


Merci pour ces préciseuse infos

(je n'avais pu vu ce fil auparavant (ou alors je ne m'en souvenais plus)

Les modules de classe et moi c'est comme moi et le patin à glace...

je ne sais pas trop faire

Précision :J'essaye de faciliter la saisie de données dans un planning
(d'ou cet exemple)
en ajoutant à la saise basique (manuelle): 1 chiffre dans une cellule
l'utilisation du menu contextuel pour ajouter une shape avec texte
pour ne pas perturber les calculs dans Excel.

(Et je ne serai pas l'utilisateur final du classeur)

Mais avant d'aller plus loin, j'essaye de savoir si ce type de solution
(personnalisation du menu CELL) ne va pas créer plus de problème
que de confort d'utilisation.

Voila pourquoi je m'adresse à vous, gens d'XLD.

Je vais potasser le fil que tu as cité.

Bonne fin de soirée à tous

A+

JM

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re,

Pour ta question b) 2 propositions, si j'ai bien compris... :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'***Après avoir désactivé le menu contextuel
'***Tableau des valeurs possibles insérées dans la cellule active
Valeurs = Array("2", "3", "4", "6", "CA", "F")

If Target.Column <= 7 And Not Target.Row = 1 And Target.Row <= 10 Then Target.Value = Valeurs(NbClic)
NbClic = NbClic + 1
If NbClic > 5 Then NbClic = 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'***Tableau des valeurs possibles insérées dans la cellule active
Valeurs = Array("2", "3", "4", "6", "CA", "F")

If Target.Column <= 7 And Not Target.Row = 1 And Target.Row <= 10 Then Target.Value = Valeurs(NbClic)
NbClic = NbClic + 1
If NbClic > 5 Then NbClic = 0
End Sub

Cordialement

Edit : Il faut déclarer NbClic en variable Public. Et pas lu ta réponse...

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re


->Spitnolan08

REDIT: apres retest

Private Sub Worksheet_BeforeRightClick
se rapproche de l'idée initiale

j'ai testé ton code
Une précision:
C'est quand on clique dans la même cellule que la boucle (des valeurs)
doit s'effectuer
ex: 1er clic en A2
A2=2, on clique une 2ème fois, A2=3 ... on clique n fois A2=Valeurs(n)

Merci en tout cas pour la piste à suivre

EDIT: L'utilisation de Shapes me permet d'éviter d'altérer la valeur de la cellule
Et la solution par clics successifs risque de fatiguer la main de l'utilisateur
(Car le cela fait un cycle de six clics ... )

Je ne sais pas quelle direction privilégier

Quel est votre avis sur la question?

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re,

Pour la fatigue de ton utilisateur je ne sais pas..., mais une dernière version pour la nuit qui semble plus proche de ce que tu veux faire sans avoir cherché de simplification de code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'***Tableau des valeurs possibles insérées dans la cellule active
Valeurs = Array("2", "3", "4", "6", "CA", "F")
Dim i as integer

If Target.Count > 1 Then Exit Sub
If Target.Column <= 7 And Not Target.Row = 1 And Target.Row <= 10 Then
    If Target.Value = "" Then
        Target.Value = Valeurs(0)
    Else
        For i = 0 To UBound(Valeurs)
          If Valeurs(i) = CStr(Target.Value) Then
                If i =5 Then i= 0
                Target.Value = Valeurs(i + 1)
                Exit For
            End If
        Next
    End If
End If
End Sub

Cordialement

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re

->Spitnolan08: Merci de ton intérêt (et pour ton code VBA)

Pendant que tu rédigeais ta dernière version, qui a l'avantage de ne pas toucher
au menu contextuel ...

--->>EDIT: je suis toujours en stand-by sur la direction à suivre
-Ta solution (la plus directe, la plus souple) (--> mais prob. formules)
ou
-Créer des shapes à la volée (-> Problème pour gèrer leur création/effacemnt) <<---FIN EDIT

...je me dirigais sur cette voie (avec Shapes)


Dans un module Standard

[B]Public NbClic As Byte[/B]

Dans ThisWorkBook

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
edit :CommandBars("Cell").Enabled = Not CommandBars("Cell").Enabled
Valeurs = Array("2", "3", "4", "6", "CA", "F")
If Target.Column <= 7 And Not Target.Row = 1 And Target.Row <= 10 Then
Select Case NbClic
Case 0 To 5
Set c = ActiveCell
Set shp = ActiveSheet.Shapes.AddShape _
   (msoShapeRectangle, c.Left, c.Top, c.Width, c.Height)
shp.BlackWhiteMode = msoBlackWhiteBlack
   With shp.TextFrame
       .Characters.Text = Valeurs(NbClic)
       .Characters.Font.Size = 11
       .Characters.Font.Superscript = True
   End With
shp.Line.Visible = msoFalse
shp.Fill.Visible = msoFalse
End Select
End If
NbClic = NbClic + 1
If NbClic > 5 Then NbClic = 0
End Sub

L'utilisateur final d'habitude saisissait manuellement les valeurs numériques (utilisées dans des formules) -> d'ou insertion des "Rectangles" dans le cellule (préservation des calculs)

edit: Précision
Je mets le code dans Private Sub Workbook_SheetSelectionChange
(|--> 12 feuilles mensuelles (basées sur un même modèle) dans le classeur )

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonjour Stapple,

En fait, je crois que je n'ai pas bien compris la philosophie qui te commande...
A quoi te servent tes rectangles ? Pourquoi parles tu d'altération de cellule ?
J'avais compris que lorsqu'une cellule contenait une valeur il fallait l'incrémenter lors d'un clic et que cette incrémentation devait se porter au cran suivant uniquement. Ex : J'ai "2" dans la cellule, Si je modifie cette cellule elle ne peut que prendre la valeur "3" qui est la suivante dans la liste de valeurs. C'est ce que fait le code que je t'ai transmis, mais ce n'est visiblement pas ce que tu souhaites. Inconvénient de ce type de code dans ce cas de figure quand même : si tu cliques par erreur sur une cellule elle va s'incrémenter automatiquement. Donc si erreur il faut faire 5 clics pour revenir en arrière.

Pourrais tu essayer d'expliquer différemment ce que tu veux faire ?
En gardant à l'esprit que parfois le mieux est l'ennemi du bien...

Autre piste Données/Validation => Liste. Mais comme je n'ai toujours pas compris où tu veux en venir

Cordialement

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonjour Spitnolan

edit: d"solé pour cette réponse tardive
mais problème de connexion ce jour

Voici un nouveau fichier

avec des explications plus claires dedans (j'èspère)
edit:
valeurs autorisées: 2 à 6 (par saisie manuelle ou macro)

ajout valeurs spéciales (lettres) dans shapes
pour éviter d'invalider les formules du type:

(=NB.SI(B3:B15;"<=6")

J'espère avoir été plus clair

Merci de ton aide.

A+


JM

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re,

Ici par exemple: en B5 (La saisie pouvant se faire manuellement pour les chiffres) La valeur est manuellement saisie est 5 (mais c'est un cas particulier , on rajoute donc A,B,C,D,E,F au choix dans une forme (un rectange) par VBA Ce qui n'influe pas sur le calcul de la formule en en ligne 17

Je ne sais pas si sous 2000 ça fonctionnait déjà comme ça, mais avec 2003 la présence de caractères alpha dans les références d'une formule ne la perturbe pas. Ainsi, que je saisisse en B5 un chiffre ou une lettre la formule se comporte comme il faut.

Si ce n'est pas le cas chez toi, il va effectivement falloir trouver une parade.
A te lire.
Cordialement

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re


Sous Excel 2000, ca ne fonctionne pas

B3=2

B4=4A


=NB.SI(B3:B15;"<=6") ---> renvoie 1 (au lieu de 2)

Pour re préciser:
Dans un premier temps on saisit (manuellement actuellement) des valeurs numériques
(de 2 à 6)
Dans certains cas on doit rajouter une letrre pour compléter le chiffre saisi.

Le problème est que sous (XL97/XL2000) si on ajoute une lettre dans une cellule

la formule suivante est fausse: =NB.SI(B3:B15;"<=6")

Le but recherché est donc: lorsque l'on clique (clic-droit par exemple) sur une cellule
non vide
1 clic-> inscrit une valeur (la 1ère de : Valeurs = Array("A", "B", "C", "D", "E", "F") )
n clic -> n valeur du tableau Valeurs()
6ème clic -> dernière valeur du tableau Valeurs()

Et 7ème clic, on recommence au début du tableau.

Actuellement, problème lors de la création car je crée une forme à chaque clic (lol)

-> Spitnolan08: le classeur sera utilisé sous XL97


a+


JM

 

[Spitnolan08]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonsoir Stapple,

Dans ce cas, je te propose sur la base de ton dernier code (Un peu feignant ce soir...):
Une autre méthode t'évitant les shapes

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Set Zone_Saisie = ActiveSheet.Range("B3:AF15")
On Error Resume Next
Application.CommandBars("Cell").Enabled = False
Valeurs = Array("A", "B", "C", "D", "E", "F")

If Not Intersect(Target, Zone_Saisie) Is Nothing Then
    Select Case NbClic
        Case 0 To 5
        Selection.NumberFormat = 0 & Valeurs(NbClic)
    End Select
End If

NbClic = NbClic + 1
If NbClic > 5 Then NbClic = 0
ez = True
End Sub

A améliorer si le principe te convient car il y a pour l'instant des effets secondaires indésirables...liés au type d'évènementielle utilisée.

Cordialement

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Bonsoir Spinolan08


edit : J'ai essayé ton dernier code avec un succès (mititigé) (XL200)

et je ne comprends pas ou ca coince ???

Ca fonctionne jusqu' 5 clics si je mets le code dans
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

edit:

A améliorer si le principe te convient

Oui ton idée et son principe me conviennent tout a fait

Reste plus qu'à trouver pourquoi cela bugge

(Erreur 1004:
Impossible de définir la propriété NumberFormat de la classe Range)

Avec cette ligne
Target.Value = Valeurs(NbClic) ' pas de bug ??? je comprends pas

 

[fred65200]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

bonsoir staple1600
Point n° 1
pour effacer une forme au clic, il faut faire appelle à application.caller

Sub SupprShape()
 ActiveSheet.Shapes(Application.Caller).Delete
End Sub

'pour appliquer la macro aux formes
Sub AppliquerMacro()
For Each Sh In ActiveSheet.Shapes
'if not Sh.name = "Oval 6" then Sh.OnAction = "SupprShape"
If Sh.OnAction = "" Then Sh.OnAction = "SupprShape"
Next
End Sub

La propriété caller semble méconnue, troisième post sur son utilisation ce week end.

Autres points

Pas encore regardé

Salutations
fred65200

 

[Staple1600]

Re : [VBA] Personnaliser CommandBars("Cell")-Demande de conseils

Re

Sur une dernière intuition avant dodo

Merci la caféine


Selection.NumberFormat = 0 & Chr(34) & Valeurs(NbClic) & Chr(34)

et cela fonctionne