Sujet Précédent Sujet Suivant

Graphique et formule VBA

Résolu/Fermé
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 - 9 janv. 2012 à 15:09
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 - 11 janv. 2012 à 09:59
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.

A voir également:

19 réponses

Réponse 1 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
Modifié par lermite222 le 10/01/2012 à 10:40
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.
1
Réponse 2 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
Modifié par lermite222 le 10/01/2012 à 11:11
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.
1
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 11:14
Ok, je regarde ça. Merci bien. Et bonne journée
0
Réponse 3 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
9 janv. 2012 à 16:19
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... ?
0
Réponse 4 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
Modifié par lermite222 le 9/01/2012 à 16:44
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.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
9 janv. 2012 à 16:47
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 ?
0
Réponse 6 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
9 janv. 2012 à 17:03
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+
0
Réponse 7 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
9 janv. 2012 à 17:39
Un très grand merci "Lermite222". Excellent travail.

A bientôt.
0
Réponse 8 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
9 janv. 2012 à 17:58
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
0
Réponse 9 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
9 janv. 2012 à 18:56
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.
0
Réponse 10 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 09:45
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
0
Réponse 11 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 10:59
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.
0
Réponse 12 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
10 janv. 2012 à 11:49
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.
0
Réponse 13 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 12:58
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.
0
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
10 janv. 2012 à 13:12
Voir mon dernier poste.
Concernant l'affichage des..indices (+1 +2 +4 -2..etc) possible en ajoutant une colonne mais je pense que se serait contre-productif, l'utilisateur ne devrais pas savoir l'influence que sont choix va avoir sur le résultat final.
Maintenant je ferme, à ce soir.
0
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 15:04
Réponse juste.

Ok je verrais en fonction de mes besoins. Merci :)
0
Réponse 14 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
10 janv. 2012 à 13:06
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.
0
Réponse 15 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 14:31
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.
0
Réponse 16 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 17:41
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
0
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
10 janv. 2012 à 17:48
Ci joint : https://www.cjoint.com/?BAkrKg1fOLw
0
Réponse 17 / 19
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
11 janv. 2012 à 08:32
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+
0
Réponse 18 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
11 janv. 2012 à 09:22
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.
0
Réponse 19 / 19
Darkam1 Messages postés 170 Date d'inscription mardi 9 août 2011 Statut Membre Dernière intervention 22 février 2016 18
11 janv. 2012 à 09:59
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
0

Discussions similaires

je veut créer des codes
jonkiller -
Nhhi -

20 réponses
exo pix
Xtyller -
Raymond PENTIER -

2 réponses
Formule Excel : "SI" une cellule contient un mot, alors ?
Tonio5933 -
Mike-31 -

9 réponses