Graphique et formule VBA Résolu

Question

Bonjour à tous et à toutes

J'expose mon problème

Dans le fichier que vous pouvez consulter via : http://cjoint.com/12jv/BAjpdUl0eAb.htm

Plusieurs problèmes s'exposent.

Premièrement dans la première feuille qui se nomme : « Scoring », vous pouvez apercevoir deux colonnes
Une qui est le total de la note ATTRAIT et la deuxième qui est le total de la note ATOUT.
Le premier total « TOTAL ATTRAIT » et le résultat de plusieurs choix dans « Maitre d'ouvrage », « Architecte/Maitre d'oeuvre »etc... La somme de ces deux résultats affichera le résultat sur le graphique de la feuille « Matrice de Postionnement ». (X et Y).

À ce jour j'utilise une formule incluse dans la feuille « Scoring » :

Sub comptage()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$16,$D$23,$D$31,$D$39,$D$47,$D$52" Then Range("D56") = Range("D56") + 0
If Target.Address = "$D$29,$D$30,$D$38,$D$46" Then Range("D56") = Range("56") + 1
If Target.Address = "$D$15,$D$22,$D$28,$D$37,$D$45,$D$51" Then Range("D56") = Range("D56") + 2
If Target.Address = "$D$14,$D$21,$D$36,$D$44" Then Range("D56") = Range("D56") + 3
If Target.Address = "$D$17,$D$24,$D$32,$D$40,$D$53" Then Range("D56") = Range("D56") - 1
If Target.Address = "$D$18,$D$25,$D$33,$D$41,$D$48,$D$54" Then Range("D56") = Range("D56") - 2
End Sub

Cette formule sert a comptabiliser le nombre de cliques sur les cases D16 (+0) ou D15 (+2) etc.
Ce résultat s'affiche dans le graphique.
Le problème c'est que ma formule ne fonctionne pas et n'affiche rien sur « D56 » (du coup je n'ai pas fait le « TOTAL ATOUT».
Une solution ? Mon code n'est pas du tout optimisé ?

Deuxième problème :

Dans mon graphique « Matrice de Positionnement » l'abscisse et l'ordonnée sont inversées.

La note ATTRAIT donne le résultat ATOUT (et vis vers ça)...

Une solution ?

Troisième problème :

Dans le graphique je voudrais mettre les graduations [0,1,2,3,4,5,6,7,8,9,10,11,12] ou se situe les flèches rouges...

Possible ou pas ?

Amicalement. 

Configuration: Pc portable : Asus

Multi-boot LILO : Backtrack / Seven

Darkam1 · Answer

J'ai trouvé pour les deuxième et le troisième problème. 

Le deuxième il suffisait d'inverser les cellules dans la formule (en cliquant sur le losange rouge).

Pour la troisième il suffisait  de modifier "L'axe vertical coupe" (dans options d'axe)

Et de saisir une valeur négatif a l'axe (-20) pour ma part. L'automatique n'est pas en mesure de répondre forcément a nos besoins... 

Une solution pour ma première question... ?

lermite222 · Answer

Bonjour,    
Tu n'est pas dans la bonne sub.. faut mettre dans WorkSheet_Change    
Private Sub Worksheet_Change(ByVal Target As Range) 

End Sub
Edit : Mais c'est pas tout, ça ne marchera pas comme tu fais, je reviens avec une solution.
A+    
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)    
NOTE : Je ne répond pas aux MP pour les questions techniques.

Darkam1 · Answer

Ca ne fonctionne pas.

J'ai changé la formule, mais Excel m'a fait un Mega bug (Il  s'est mis sélectionné toutes les cases dues a la fonction "Target")..


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = "$D$16,$D$23,$D$31,$D$39,$D$47,$D$52" Then Range("D56") = Range("D56") + 0
Range("D16,D23,D31,D39,D47,D52").Select
If Target.Address = "$D$29,$D$30,$D$38,$D$46" Then Range("D56") = Range("D56") + 1
Range("D29,D30,D38,D46").Select
If Target.Address = "$D$15,$D$22,$D$28,$D$37,$D$45,$D$51" Then Range("D56") = Range("D56") + 2
Range("D15,D22,D28,D37,D45,D51").Select
If Target.Address = "$D$14,$D$21,$D$36,$D$44" Then Range("D56") = Range("D56") + 3
Range("D14,D21,D36,D44").Select
If Target.Address = "$D$17,$D$24,$D$32,$D$40,$D$53" Then Range("D56") = Range("D56") - 1
Range("D17,D24,D32,D40,D53").Select
If Target.Address = "$D$18,$D$25,$D$33,$D$41,$D$48,$D$54" Then Range("D56") = Range("D56") - 2
Range("D18,D25,D33,D41,D48,D54").Select
End Sub

Une solution ? Possibilité de faire une boucle plutôt que du gavage de IF ?

lermite222 · Answer

Comme ça ça va aller.. :-)
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 4 Then Exit Sub 'éviter toutes les autres cellules.
    If Not Intersect(Target, Union([D16], [D23], [D31], [D39], [D47], [D52])) Is Nothing Then
    '?????????????????  à quoi ça sert Range("D56") = Range("D56") + 0
    ElseIf Not Intersect(Target, Union([D29], [D30], [D38], [D46])) Is Nothing Then
       [D56] = [56] + 1
    ElseIf Not Intersect(Target, Union([D15], [D22], [D28], [D37], [D45], [D51])) Is Nothing Then
        [D56] = [D56] + 2
    ElseIf Not Intersect(Target, Union([D14], [D21], [D36], [D44])) Is Nothing Then
        [D56] = [D56] + 3
    ElseIf Not Intersect(Target, Union([D17], [D24], [D32], [D40], [D53])) Is Nothing Then
        [D56] = [D56] - 1
    ElseIf Not Intersect(Target, Union([D18], [D25], [D33], [D41], [D48], [D54])) Is Nothing Then
       [D56] = [D56] - 2
    End If
End Sub
A+

Darkam1 · Answer

Un très grand merci "Lermite222". Excellent travail.

A bientôt.

Darkam1 · Answer

J'ai voulu faire comme toi mais cela ne fonctionne pas... (J'ai voulu faire le total ATOUT)..




Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 4 Then Exit Sub 'éviter toutes les autres cellules.
    If Not Intersect(Target, Union([D16], [D23], [D31], [D39], [D47], [D52])) Is Nothing Then
    ElseIf Not Intersect(Target, Union([D29], [D30], [D38], [D46])) Is Nothing Then
       [D56] = [D56] + 1
    ElseIf Not Intersect(Target, Union([D15], [D22], [D28], [D37], [D45], [D51])) Is Nothing Then
        [D56] = [D56] + 2
    ElseIf Not Intersect(Target, Union([D14], [D21], [D36], [D44])) Is Nothing Then
        [D56] = [D56] + 3
    ElseIf Not Intersect(Target, Union([D17], [D24], [D32], [D40], [D53])) Is Nothing Then
        [D56] = [D56] - 1
    ElseIf Not Intersect(Target, Union([D18], [D25], [D33], [D41], [D48], [D54])) Is Nothing Then
       [D56] = [D56] - 2
        If Not Intersect(Target, Union([I17], [I31], [I37], [I44], [I48])) Is Nothing Then
    ElseIf Not Intersect(Target, Union([I16], [I22], [I30], [I36], [I43])) Is Nothing Then
       [I56] = [I56] + 1
    ElseIf Not Intersect(Target, Union([I15], [I29], [I42])) Is Nothing Then
        [I56] = [I56] + 2
    ElseIf Not Intersect(Target, Union([I14], [I21], [I28], [I35], [I41])) Is Nothing Then
        [I56] = [I56] + 3
    ElseIf Not Intersect(Target, Union([I24], [I32], [I45])) Is Nothing Then
       [I56] = [I56] - 2
    ElseIf Not Intersect(Target, Union([I49])) Is Nothing Then
        [I56] = [I56] - 5
    End If
End Sub

lermite222 · Answer

Supprime ces  lignes..
If Target.Column <> 4 Then Exit Sub 'éviter toutes les autres cellules. 
If Not Intersect(Target, Union([D16], [D23], [D31], [D39], [D47], [D52])) Is Nothing Then 
Et change la suivante
ElseIf Not Intersect(Target, Union([D29], [D30], [D38], [D46])) Is Nothing Then 
par
If Not Intersect(Target, Union([D29], [D30], [D38], [D46])) Is Nothing Then 
Les 3 lignes du dessus servent à rien.

Darkam1 · Answer

Malgrès la suppresion des lignes, cela ne fonctionne toujours pas. Pourtant j'ai suivi a la les lettres tes indications. De plus pour la note "ATOUT", j'ai enlevé la ligne qui stipulé de ne pas réagir face au +0. Il est vrai qu'elle ne servait pas a grand chose.

Voici mon code : 

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Union([D29], [D30], [D38], [D46])) Is Nothing Then
[D56] = [D56] + 1
ElseIf Not Intersect(Target, Union([D15], [D22], [D28], [D37], [D45], [D51])) Is Nothing Then
[D56] = [D56] + 2
ElseIf Not Intersect(Target, Union([D14], [D21], [D36], [D44])) Is Nothing Then
[D56] = [D56] + 3
ElseIf Not Intersect(Target, Union([D17], [D24], [D32], [D40], [D53])) Is Nothing Then
[D56] = [D56] - 1
ElseIf Not Intersect(Target, Union([D18], [D25], [D33], [D41], [D48], [D54])) Is Nothing Then
[D56] = [D56] - 2

If Not Intersect(Target, Union([I16], [I22], [I30], [I36], [I43])) Is Nothing Then
[I56] = [I56] + 1
ElseIf Not Intersect(Target, Union([I15], [I29], [I42])) Is Nothing Then
[I56] = [I56] + 2
ElseIf Not Intersect(Target, Union([I14], [I21], [I28], [I35], [I41])) Is Nothing Then
[I56] = [I56] + 3
ElseIf Not Intersect(Target, Union([I24], [I32], [I45])) Is Nothing Then
[I56] = [I56] - 2
ElseIf Not Intersect(Target, Union([I49])) Is Nothing Then
[I56] = [I56] - 5

End If
End Sub


Et voici le fichier qui comprend le code et l'erreur
 : 	https://www.cjoint.com/?BAkjS2MwBxg

Merci

lermite222 · Answer

Re, 
ton classeur en retour 
Remarques :  
Tu n'a aucun contrôle sur le nombre de fois que l'ont a cliquer. 
Ce n'est pas fort ergonomique. 
C'est inutile de travailler avec un zoom, vaux mieux travailler en normal et quand c'est terminer éventuellement jouer sur le zoom. 
Pour le type d'application que tu fais, tu pourrais t'intéresser à cette démo 
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius) 
NOTE : Je ne répond pas aux MP pour les questions techniques.

Darkam1 · Answer

Merci à toi pour ce retour.

J'ai eu un peu de mal à comprendre ton code. Mais finalement, je crois avoir compris. 

Merci d'avoir pris le temps de me comprendre et de me répondre. 

La démo que tu as faite n'est pas disponible pour les versions 64 bits ? Je tente de voir ce que fait la suppression de ce code :


'pour enlever la croix rouge d'un UF
 Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

 Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

 Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Encore un grand merci.

lermite222 · Answer

C'est employer pour enlever la croix rouge du formulaire et ainsi obliger l'utilisateur à quitter par le bouton.
Pour que ça fonctionne en 64 faut changer dans les déclarations d'API.. 
Long par Integer 
Exemple : 
Declare Function GetWindowLongA Lib "user32" _  
(ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius) 
NOTE : Je ne répond pas aux MP pour les questions techniques.

lermite222 · Answer

Probablement que le niveau de cette démo est trop difficile pour toi pour le moment, tu pourras y revenir plus tard mais dans l'immédiat, pour remédier au problème que j'ai soulever plus haut, (pas de contrôle sur les cellules cliquées) donc montant imprévisible regarde si ce ne serait pas mieux avec l'exemple que j'ai mis dans un nouveau classeur
Attention, je n'ai rien fait dans le code et je n'ai fait que la colonne D, si ça t'intéresse je pourrais facilement l'adapter.
Tu dis.

Darkam1 · Answer

Oui effectivement je n'ai pas de grande connaissance en VBA. Je jetterai un oeil quand même.


Je viens de voir ce que tu as fait. C'est très intéressant. Si le temps te le permet, se sera avec joie. Pourrait tu ré-inclures sur le coté les indices (+1 +2 +4 -2..etc)

Tu vas t'y prendre comment ? 


Merci bien.

lermite222 · Answer

Je doit partir mais pour pas te faire attendre au cas ou...
Nouveau classeur
Je n'ai fait que les lignes 27 à 48 de la colonne D
T'en fais pas pour les cellules avec des ## ou des chiffres je t'expliquerais après comment faire.
Si tu veux essayer de continuer..
Lier chaque Option avec la cellule de droite de la même ligne colonne D
Ruban Développeur >> cocher Mode Création
Clic droit sur un option >> Propriétés.
Repèrer la propriété LinkedCell et mettre l'adresse de la cellule.
Dans la colonne E copier les formules que j'ai mis dans l'exemple en adaptant les montant à afficher.

Darkam1 · Answer

C'est juste excellent. 

Du coup j'ai fait toute la colonne de 14 a 55. 

Par contre je n'arrive pas a enlever les # ni a voir les vrais chiffres. Les chiffres apparaissent que si seulement on sélectionne la case. 


De plus j'aurai une autre question :

Comme tu peux le voir sur la fiche;  il est écrit en bas de page : 

"Commentaires :		
Une affaire 3 fois notée -2 doit être éliminée."	

Du coup je voulais savoir via une fonction IF ; si l'utilisateur sélectionne 3 notes a  -2 (que se soit ATTRAIT ou ATOUT) une cellule (proche du commentaire) écrivent : "Affaire éliminé" (Si possible en VBA que cette cellule clignote en rouge et blanc).


Amicalement


Très bon travail. Je continue de remplir les deux TOTAUX et puis ensuite je t'envoie le fichier pour que tu m'expliques comment enlever les #et afficher les vrais chiffres.

Darkam1 · Answer

Comme tu peux le voir, ça fonctionne. J'ai masqué les cellules qui comprenaient des # (ou réduire). 

Malgré mes recherches je n'arrive toujours pas à intégrer une fonction IF (voir ci-dessus) ainsi qu'un code qui fonctionne pour un clignotement. Apparemment le VBA ne gère pas le temps du coup il faut prendre en compte le temps de Windows..

Je te laisse regarder...

Ce n'est pas bien grave si tu ne trouves pas. Dans ce cas; il serait intéressant que si au minimum l'utilisateur prend 3 fois la note -2 alors afficher sur une cellule  "ÉLIMINE". 


Merci à toi

lermite222 · Answer

Ton classeur
Le cumule du 3 et 4 est limité à 4 >> Fait 
Met un troisième -2 pour voir.
Note : J'ai considéré que le -5 était inclus dans l'avertissement, si faut pas tu dis.
A+

Darkam1 · Answer

Il ne fallait pas considérer le -5 comme dans l'avertissement. J'ai pris le choix de le modifier moi même.

Sinon rien à dire excellent travail. La boîte d'erreur est très bien pensée. 


A bientôt.

Darkam1 · Answer

J'avais une autre question. Est-il possible qu'après avoir rempli les deux totaux "Atout Attrait", qu'une Msgbox apparaissent demandant si oui ou non l'utilisateur voudrait une sauvegarde de ça matrice de positionnement (Feuille 2). Ainsi, si l'utilisateur dit OUI, cela sauvegardera la matrice de positionnement à chaque fois qu'il le modifie. (Voir image)

Cela permettra de voir l'évolution de son étude.

Le plus intéressant serait qu'il y est une duplication du point avec la date en dessous : 
	https://www.cjoint.com/?BAlj2sbqwfu

J'ai pensé à une macro permettant une impression d'écran de la matrice de positionnement à chaque fois que l'utilisateur quitte la page Excel avec une copie de l'image dans une nouvelle feuille. Mais je ne trouve pas d'autre code qu'en 32 bits. De plus, je pense qu'il y'a d'autres solutions. Le graphique d'Excel peut prendre en compte les changements ? 

Merci pour tout.



Option Explicit

Private Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)

Private Sub commandButton1_Click()
    keybd_event vbKeySnapshot, 1, 0&, 0&
    DoEvents
    
    Range("A1").Select
    ActiveSheet.Paste
End Sub

Graphique et formule VBA

19 réponses

Discussions similaires

Newsletters