Encore un casse tête désolé :)

M

morest

XLDnaute Occasionnel
Bonjour à tous,

Moi qui pensais bien enfin bien m'en sortir et profiter de mes acquis sans vous solliciter et vous faire perdre votre temps :). Je vais finir par culpabilisé.

Aujourd'hui je dispose de 5 cases qui ne doivent jamais être active en même temps. (le chiffre quel doivent renvoyer lorsque l'on clic dessus est soit leur chiffre soit 0 pour désactiver la cellule). En fonction du nombre de la cellule T27 la cellule associé change de couleur. Si la valeur est 0 elle revient à son format initial.

Code: 
    If Not Application.Intersect(Target, Range("G36")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 0
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 1
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 1
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If
    If Not Application.Intersect(Target, Range("C38")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 2
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 2
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 0
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 2
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 2
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 2
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If
    If Not Application.Intersect(Target, Range("C39")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 3
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 3
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 3
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 0
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 3
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 3
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If
    If Not Application.Intersect(Target, Range("G38")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 4
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 4
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 4
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 4
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 0
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 4
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If
    If Not Application.Intersect(Target, Range("G39")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 5
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 5
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 5
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 5
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 5
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 0
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If

Long code mais en fait c'est que du copier coller. Sur une worksheet bien entendu.

Mon problème est que lorsque je clic sur les cellule renvoyant 1 ou 2 pas de problème tout marche mais dès que ma cellule T27 est égale à 3 4 ou 5 alors la problème plus rien ne bouge.

Je pense que mon code est trop compliqué pour être stable et doit être compresser mais après multiple tentative rien y fait.

C'est pourquoi j'ai une nouvelle fois besoin de votre science. Merci d'avance à tous ce qui auront pris le temps de passer par ce sujet.
 
Dernière édition:
Trier par date Trier par votes
K

kjin

XLDnaute Barbatruc
Re : Encore un casse tête désolé :)

Bonjour,
primo : avec un code rangé comme ça, rien d'étonnant si tu ne t'y retrouves pas
deusio : un bout de fichier et une note d'explication claire seraient sans doute plus efficace qu'un GPS + un décodeur
troisio : tu ne gères apparemment pas les événements....
A+
kjin
 
Vote positif 0 Vote négatif
B

Banzai64

XLDnaute Accro
Re : Encore un casse tête désolé :)

Bonjour

Oui vu le code pas facile a s'y retrouver

Regarde ce que j'ai fait si c'est dans l' optique
 

Pièces jointes

  • Casse tête.xls
    21.5 KB · Affichages: 47
  • Casse tête.xls
    21.5 KB · Affichages: 47
  • Casse tête.xls
    21.5 KB · Affichages: 42
Vote positif 0 Vote négatif
M

morest

XLDnaute Occasionnel
Re : Encore un casse tête désolé :)

Merci de t'intéresser à mon problème Banzai. Oui ca pourrait être la voie à suivre cependant mes cellules ne sont pas les une au dessus des autres. Comment puis-je adapter ton code pour avoir des cellules non jointes et que la valeur de ces cellules en soit indépendante? :)

En espérant que ma question n'est pas trop vague.
 
Vote positif 0 Vote négatif
M

morest

XLDnaute Occasionnel
Re : Encore un casse tête désolé :)

Oui, ca s'est nikel. Pour que ce soit parfait il ne manquerais plus que de pouvoir obtenir ces valeurs sans que cela modifie la valeur de la cellule d'origine.

En gros si clic sur I14 par exemple alors Z1=4. :)

Merci encore.
 
Vote positif 0 Vote négatif
M

morest

XLDnaute Occasionnel
Re : Encore un casse tête désolé :)

Je pense que j'ai encore fait quelque chose de mal :)

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range
Dim Kase As Range
Dim Num As Integer


  Set Plage = Union(Range("E26"), Range("G18"), Range("H16"), Range("I14"), Range("I24"))
  If Not Intersect(Plage, Target) Is Nothing Then
    Application.EnableEvents = False
    Plage = 0
    For Each Kase In Plage
      Num = Num + 1
      If Kase = Target Then Range("Z1") = Num
    Next Kase
    Application.EnableEvents = True
  ElseIf Not Intersect(Range("E7:E11"), Target) Is Nothing Then
    Application.EnableEvents = False
    Range("E7:E11") = 0
    Target = Target.Row - 6
    Application.EnableEvents = True
  End If



End Sub

Z1 recoit bien la valeur 1 2 3 4 ou 5 mais lorsque l'on clique sur une autre case on obtient pas la nouvelle valeur. Pareil lorsque l'on clique sur la même cellule on obtiens pas 0. :( ^^
 
Vote positif 0 Vote négatif
B

Banzai64

XLDnaute Accro
Re : Encore un casse tête désolé :)

Re

Houlala je n'y comprends pas grand-chose (l'âge surement)

Essayes ceci
Sinon désolé et reviens avec un fichier avec ce que tu veux exactement et très détaillé
 

Pièces jointes

  • Casse tête 002.xls
    28 KB · Affichages: 60
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Encore un casse tête désolé :)

Salut morest et le forum

Code: 
    If Not Application.Intersect(Target, Range("G36")) Is Nothing Then
    With Target
    If Range("T27") = 0 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 1 Then
    Range("T27") = 0
    Range("B29").Select
    Else
    If Range("T27") = 2 Then
    Range("T27") = 1
    Range("B29").Select
    If Range("T27") = 3 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 4 Then
    Range("T27") = 1
    Range("B29").Select
    Else
    If Range("T27") = 5 Then
    Range("T27") = 1
    Range("B29").Select
    End If
    End If
    End If
    End If
    End If
    End If
    End With
    End If
En partant de cet extrait de ton code initial, avec une utilisation des indentations, on obtient :
Code: 
If Not Application.Intersect(Target, Range("G36")) Is Nothing Then
    With Target
        If Range("T27") = 0 Then
            Range("T27") = 1
            Range("B29").Select
        Else
            If Range("T27") = 1 Then
                Range("T27") = 0
                Range("B29").Select
            Else
                If Range("T27") = 2 Then
                    Range("T27") = 1
                    Range("B29").Select
                    If Range("T27") = 3 Then
                        Range("T27") = 1
                        Range("B29").Select
                    Else
                        If Range("T27") = 4 Then
                            Range("T27") = 1
                            Range("B29").Select
                        Else
                            If Range("T27") = 5 Then
                                Range("T27") = 1
                                Range("B29").Select
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End With
End If
On voit tout de suite l'erreur : si T27=2, on teste s'il n'est pas égal à une valeur supérieure, dans les autres cas, non :D.
L'indentation ne sert pas à faire "joli", mais à se retrouver dans les boucles, tests, etc... Et ça rend le code plus lisible.

Dans ton code, l'utilisation de Target ? Tu ne mets en préfixe, avec With, mais tu ne l'utilises pas !

Donner un extrait de code n'est jamais suffisant : l'erreur peut provenir d'ailleurs de ce que tu crois. Il faut toujours donner le code de la macro en intégral (depuis la ligne de titre jusqu'à End Sub) et une explication de ce que tu voudrais qu'elle fasse.

Nota : "If Not Application.Intersect(...) Is Nothing Then" implique que ce ne soit pas des cellules vides, sinon, intersection renvoie Nothing :eek:

Une proposition de ce que je crois avoir compris :
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Val As Integer
Select Case ActiveCell.Address(0, 0)
    Case "G36"
        Val = 1
    Case "C38"
        Val = 2
    Case "C39"
        Val = 3
    Case "G38"
        Val = 4
    Case "G39"
        Val = 5
End Select
If Val = 0 Then Exit Sub
If [T27] = Val Then [T27] = 0 Else [T27] = Val
End Sub
On ne peut pas se servir de Target pour deux raisons :
- Les cellules peuvent être vides => donc l'intersection est vide
- On peut sélectionner plusieurs cellules. Mais il n'y a qu'une seule cellule active.
On donne une valeur à Val avec "select case". Si la valeur donnée est égale à T27 (on sélectionne une deuxième fois une des cinq cellules, après avoir sélectionné une autre cellule hors des cinq), on affiche 0, sinon, on affiche le nombre attribué à la cellule.

Remarques : sur le code que tu fournis, ce ne sont plus les mêmes cellules ???

Perso, l'utilisation d'une instruction modifiant le fonctionnement général d'Excel (dans ton code : EnableEvents), m'impose une gestion des erreurs, pour remettre à son fonctionnement initial Excel, même s'il détecte une erreur.
A+
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
313
dadu35
D
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
192
fanch55
fanch55
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
204
chaelie2015
chaelie2015
N
  • Résolu(e)
Microsoft 365 Ajouter une condition dans une VBA
Réponses
2
Affichages
191
Nathan027
N
P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
315
pat66
P
N
  • Question
Microsoft 365 Imbrication de deux formule Worksheet_BeforeDoubleClick
Réponses
1
Affichages
143
Nathan027
N
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
207
fanch55
fanch55
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
150
rebatte
R
U
  • Question
Autres [RESOLU] Déclaration de variable
Réponses
5
Affichages
194
un internaute
U
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
121
BenExcel
B

Membres actuellement en ligne

5 membres et 53 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 810
dernier inscrit
mohammedaminelahbali