Sub RecopiePlage()

Résolu/Fermé

chrisnapoli - 1 juin 2018 à 22:51
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 - 14 juin 2018 à 09:25

Bonjour,
je n ai toujours pas de solutions pour résoudre ce problème je voudrais savoir pourquoi seule la première des conditions marche dans ce code

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
ElseIf [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
ElseIf [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
ElseIf [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub

A voir également:

Sub RecopiePlage()
D sub no signal ✓ - Forum Matériel & Système
Private sub worksheet_selectionchange(byval target as range) ✓ - Forum Programmation
Branchement sub double bobine 2x2 ohm ✓ - Forum Autoradio
Move your sub - Télécharger - Sous-titres
D sub out of range - Forum Matériel & Système

14 réponses

Réponse 1 / 14

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
1 juin 2018 à 23:44

bonsoir, peut-être en remplacant

ElseIf [BZ101] = "Ok" Then

par

End if
If [BZ101] = "Ok" Then

chrisnapoli
2 juin 2018 à 09:06

bonjour
j ai essaye ce que tu m as dit de faire, de 2 facons mais aucune ne donne de résultats et j ai toujours dans les deux cas la plage CK11:CS51 qui affiche normalement ( il y a bien inscrit égale)les 3 autres continuent a afficher leurs formules je ne sais pas ce qui ne va pas

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
2 juin 2018 à 09:16

la Sub RecopiePlage() est-elle exécutée?
pour tester, tu cliques sur la line sub, et tu fais F5.
ou tu y ajoutes un msgbox pour vérifier qu'elle est exécutée.

chrisnapoli
2 juin 2018 à 09:47

j ai fait ce que tu m 'as dit il a fallu que je clique 3 fois sur F5 et les 3 plages qui ne fonctionnaient pas se sont mis correctement je n ai plus que des =donc c'est parfait
est ce que cette solution va rester telle quelle dans le temps ??
est ce que tu peux m 'expliquer pourquoi ça ne s’exécutait pas ?? ou bien peut être est ce une procédure a faire obligatoirement??

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
2 juin 2018 à 11:28

bizarre que tu aies dû faire trois fois F5: que s'est-il passé entre-temps?
je ne sais pas pourquoi ce code se retrouve dans la procédure RecopiePlage().
quand souhaites-tu que ce code soit exécuté? peut-être chaque fois que le contenu des cellules où il peut y avoir "ok" change? ou bien via un bouton?

chrisnapoli
2 juin 2018 à 19:10

Avant c’était seulement la première plage a gauche du premier graphe qui fonctionnait en temps réel chaque fois que le OK apparaissait dans une des 5 cellules correspondantes aux plages
j ai cinq barres de progression différentes (donc 10 plages par graphe,5 de chaque coté), j ai 2 graphes soit au total 20 plages

sur les 3 autres emplacements tout fonctionnait mais avec le système d'anciennes formules statiques
Donc a présent je pense que tout devrait marcher automatiquement en temps réel sans mettre de bouton( c'est le but)
quand j ai appuyé sur F5 c'est dabord le cote droit du premier graphe qui s'est mis en place puis la deuxième fois c'est la partie droite du deuxième graphe et enfin au final la partie gauche du 2 eme graphe

j ai encore a régler le problème du timer mais je suis entrain de me poser la question si le code n 'est pas étranger au dysfonctionnement et si cela n 'est pas du à un simple problème du logiciel DDE????qui empêcherait que les quatres marchés enregistrent les cotations dans le même temps( puisque j avais déjà constaté qu il était impossible de consulter les marches en même temps et qu'il fallait sortir d'une liste pour aller activer une autre et comme la procédure de départ du timer est égale il faudrait peut être que j 'essaye d'activer le matin un autre marche que le CAC 40 et si cela fonctionne alors je pense qu il faudra que je change de logiciel DDE (certains permettent d'activer autant de liens que l 'on désire dans la même session)
la, en ce moment je suis occupé à solutionner des choses encore bien plus complexes
tant que j ai les idées en tete 'j avance même si parfois je trébuche ,l'important c'est d'avoir la bonne idée après on trouve toujours la mise en oeuvre

Réponse 2 / 14

Chrisnapoli
11 juin 2018 à 11:14

Bbonjour
j ai mis le code ainsi dans la feuille le graphe fonctionne en temps réel les OK changent de cellules au bon timing mais le pas des changements ne se répercutent pas sur les 2 graphes ????
peut être faut il linscrire a un autre emplacement????

Option Explicit

Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target
End If
End Sub

Private Sub Worksheet_Change(ByVal target As Range)
If Not Application.Intersect(target, Range("AX101,AX144,AX187,AX230,AX273")) Is Nothing Then
If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
ElseIf Not Application.Intersect(target, Range("BZ101,BZ144,BZ187,BZ230,BZ273")) Is Nothing Then
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then

etc......

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
Modifié le 11 juin 2018 à 16:39

qu'est-ce qui fait changer les "ok"?
cela fonctionne-t-'il si tu changes les "ok" à la main?

Réponse 3 / 14

Chrisnapoli
11 juin 2018 à 18:35

ce qui fait changer les OK ce sont ces formules ex sur un cote

=SI(BY101>0,0175;"OK";"")
=SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
=SI(ET(BY187>0,009;BY187<=0,014);"OK";"")
=SI(ET(BY230>0,005;BY230<=0,009);"OK";"")
=SI(ET(BY273>=0;BY273<=0,005);"OK";"")

Chaque BY correspond a un MAX d'une plage

=MAX(BO102:BW141)
=MAX(BO145:BW184)
=MAX(BO188:BW227)
=MAX(BO231:BW270)
=MAX(BO274:BW313) ce qui correspond pour ce cote a 5 barres de progressions comme ceci

0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%

0,20% 0,40% 0,60% -0,80% 1,00% 1,20% 1,40% 1,60% >1,60%

0,15% 0,30% 0,45% 0,60% 0,75% 0,90% 1,05% 1,20% >1,20%

0,10% 0,20% 0,30% 0,40% 0,50% 0,60% 0,70% 0,80% >0,80%

0,05% 0,10% 0,15% 0,20% 0,25% 0,30% 0,35% 0,40% >0,40%

le OK change chaque fois que une des cotations dépassent la condition inscrite dans les cellules BY(pour ce cote dans notre exemple)
il y a deux graphes chaque graphe a un cote positif et un cote négatif il y a au total 20 plages qui permettent de rendre les 2 graphes visiblent a l ecran beaucoup plus animés
puisque selon le max il passe de un pas de 0.05% au minimum a la plus grande progression qui est de 0.25% en 0.25% les formules dans les plages sont de ce type
exemple pour la plus petite progression de 0.05en 0.05

0,05% 0,10% 0,15% 0,20% 0,25% 0,30% 0,35% 0,40% >0,40%

=SIERREUR(SI(ET(BC12>=0;BC12<=0,0005);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0005;BC12<=0,001);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,001;BC12<=0,0015);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0015;BC12<=0,002);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,002;BC12<=0,0025);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0025;BC12<=0,003);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,003;BC12<=0,0035);BC12;"");"")
=SIERREUR(SI(ET(BC12>0,0035;BC12<=0,004);BC12;"");"")
=SIERREUR(SI(BC12>0,004;BC12;"");"")
il ya 360 formules de ce type par plage puisque cela correspond aux 40 valeurs du Cac40 soit 360*5*4=7200

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
11 juin 2018 à 20:04

si tout cela change quand les cotations changent, je pense qu'il vaut mieux retourner à la solution en #2, et faire

call RecopiePlage()

juste après avoir recopié les cotations.

Réponse 4 / 14

Chrisnapoli
11 juin 2018 à 20:47

j ai mis le code comme ceci dans la feuille a la suite du premier code quand je mets les deux parenthèses après call RecopiePlage elles s'effacent d'elles même j ai aussi le message suivant qui apparaît quand j essaye d'activer le graphe
seuls les commentaires peuvent apparaître après end sub end function ou end property
je ne sais pas si c'est pas mieux de trouver pourquoi ne marche pas le code d'avant parceque la procédure égale est parfaitement respectée, le graphe tourne en temps reel c'est seulement au changement des OK que quelque chose cloche moi je crois que c'est dans l écriture du code parce que le début du code ressemble étrangement a celui qui le précède ;hors celui qui le précède ne fonctionne que si il y a action sur les cellules et dans notre cas on a pas d'action sur les cellules c'est elles qui changent elles même

Private Sub Worksheet_Change(ByVal target As Range)
If Not Application.Intersect(target, Range("AX101,AX144,AX187,AX230,AX273")) Is Nothing Then
et
Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target le code de #2 je l ai inscrit ainsi

Option Explicit
Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Lig As Byte, Col As Byte
If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
Range("DP2") = target
End If
End Sub
Option Compare Text

Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
Call RecopiePlage
End If
End Sub

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
11 juin 2018 à 20:55

ma suggestion:
si tout cela change quand les cotations changent, je pense qu'il vaut mieux retourner à la solution en #2, et faire call RecopiePlage() juste après avoir recopié les cotations (donc, sans doute, dans le timer).

c'est quoi "le code d'avant" que tu souhaites plutôt faire marcher?

Chrisnapoli
11 juin 2018 à 21:15

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])

End If
End Sub

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > Chrisnapoli
11 juin 2018 à 21:54

je pense qu'il faut ajouter

call recopieplage()

dans le timer.

chrisnapoli
11 juin 2018 à 21:58

en fait étant donne que cela marche parfaitement avec le Bouton ,n 'est il pas possible d’écrire
si une seule des cellules (BZ101;BZ144;BZ187;BZ230;BZ273;BZ316;BZ359;BZ402;BZ445;BZ448;AX101;AX144,AX187;AX230;AX273;AX316;AX359;AX402;AX445;AX448 contenant les OK changent ;alors actionner la macro RecopiePlage

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
11 juin 2018 à 22:13

je pense que non, car ces cellules ne changent pas, leur contenus étant des formules. c'est ce qu'on avait fait en #15, mais Worksheet_Change ne fonctionnait pas, car les cellules ne changeaient pas.

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

Posez votre question

Réponse 5 / 14

Chrisnapoli
11 juin 2018 à 21:13

je viens de mettre le code dans un module a part et la macro s'actionne parfaitement-mais par bouton j ai enlevé call recopieplage() donc c'est qu on est pas du tout loin de la vérité maintenant il faut trouver un moyen que le changement de OK se fasse seul
de plus lorsque j ai essaye il y avait un résultat qui correspondait parfaitement a la réalité 2 plages étaient complètement différente d'un cote et de l autre mais ça reflétait exactement l équivalent de ce que donnait les OK

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
11 juin 2018 à 22:13

je pense qu'il faut ajouter

call recopieplage()

dans le timer.

Réponse 6 / 14

chrisnapoli
11 juin 2018 à 22:20

cela ne servirait a rien puisque le timer est a part de la partie graphique je l ai désolidarise puisque il m empêche de pouvoir travailler sur le fichier
de plus ces deux graphiques ou je veux faire changer le pas de progression me servent uniquement pour modèle afin que le develloper qui me transcrit ma logique sur le web en java script comprenne exactement ce que je fait

Réponse 7 / 14

chrisnapoli
12 juin 2018 à 19:14

Bonjour
toujours pas de solution ?? le graphe a tourne toute la journée la macro marche mais il faut l actionner ne pourrait on pas ecrire un code qui dise que lorsque un OK est dans une des 20 cellules ; alors copier en mode valeur ce OK sur la cellule directement a droite pour le cote positif et directement a gauche pour le cote negatif puis un autre code qui dit des que le contenue d 'une des 20 cellules ou est inscrit OK est egal a ("") ; actionner la macro recopie plage autant de fois qu il y a de changements ..???

les OK actuels du cote positifs sont en BY101; BY144;BY187;BY230;BY273;BY316.BY359;BY402;BY445,

les OK actuels du cote négatif en AX101; AX144;AX187;AX230;AX273;AX316.AX359;AX402;AX445

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
12 juin 2018 à 19:32

on pourrait sans doute écrire un code qui fait ce que tu décris (je n'ai pas tout compris), MAIS le soucis, c'est de déclencher l’exécution de ce code.
c'est pour cela que je pense au timer, qui, j'imagine, vient modifier les valeurs des cellules de départ. j'imagine mal? qu'est-ce qui provoque un changement dans les valeurs retournées par les formules?

Réponse 8 / 14

chrisnapoli
12 juin 2018 à 20:34

le timer est étranger complètement a cette procédure puisque on ne s'en sert pas pour ces 2 graphes

il faut dabord comprendre le systeme
a la base ce sont 2 graphiques a barres de progression identique mise a part que un donne les cotations par rapport au début de la séance et l autre par rapport a la veille
au depart j ai choisi par facilite de faire les barres avec un pas de 0.25 en 0.25 c'est a dire que la barre demarre a zero et s'arrete a 2.00% comme ceci
>-2,00% -2,00% -1,75% -1,50% -1,25% -1,00% -0,75% -0,50% -0,25% pour le negatif et
0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%pour le positif
j ai par la suite décidé pour que les graphes soient plus animes d"ajouter 5 pas cela démarre en 0.05 puis en 0.10 puis en 0.15 puis en 0.20 et au final j arrive a l ancien graphe 0.25 pour que ce systeme fonctionne j ai créé les plages correspondantes a ces graphes chaque plage a les formules adaptes pour son pas pour que le systeme s actionne j ai sélectionné chaque plage pour avoir le Max qui est évidement le même dans chaque plage c'est le critère qui est inscrit dans la cellule ou viennent se mettre les OK qui font que les plages changent
exemple si je suis dans la plus petite plage qui part de 0 a 0.40%
je dit si le max de cette plage est supérieur ou égal a 0 et inférieur ou égal a 0.50 alors mettez moi OK dans la cellule
pour la deuxième barre je mets comme critère si le max est supérieur a 0.5% et inférieur ou égal a 0.9% alors mettez moi OK dans la cellule
pour la troisiem barre je mets comme critere si le max est supérieur a 0.9% et inferieur ou egal a 1.4% alors mettez moi OK dans la cellule
pour la quatrième barre je mets comme critère si le max est supérieur a1.4% et inférieur ou égal a 1.75% alors mettez moi OK dans la cellule
pour la cinquième barre( la derniere) je mets comme critère si le max est supérieur a 1.75% alors mettez moi OK dans la cellule
pour le négatif c'est la même chose en inversant les signes
Donc c'est bien les OK qui sont chargé de régler les plages a mesure que le max augmente ou diminue
on peut parfois avoir un pas différent sur les 4 plages des 2 graphes selon les cours qui s'affichent ou doivent apparaître sur les 2 graphes principaux i
pour moi du moment que la macro provoque le changement manuellement(si un Ok a change evidement) je pense qu i est tout a fait possible de faire un code

j ai pense a dupliquer les cellules OK en mode valeur a cote pour qu il n y ai aucune formule dans la cellule vu ce que tu m 'as dit hier
je pense que le code peut distinguer une cellule OK et une cellule ou il n y a rien dedans (maintenant je ne sais pas comment s'ecrit en code la détection de changement dans une cellule????

en fait il ne faudrait plus faire référence aux plages simplement dire """chaque fois qu une des cellules passent d' OK a ("") alors actionner la macro recopieplage je ne vois pas d'autres moyens que celui ci cela fait une action pour copier en mode valeur les cellules contenant les OK et un autre code qui actionne ces cellules en mode valeur des que l une d'entre elles change

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
12 juin 2018 à 21:19

qu'est-ce qui provoque un changement dans les valeurs retournées par les formules?

chrisnapoli
12 juin 2018 à 21:26

ce sont les liens DDE qui transmettent les cours en temps reel

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
12 juin 2018 à 21:30

ce qui confirme l'idée qu'il faut appeler

call recopieplage()

dans le code du timer, qui, j'imagine, recopie les données obtenues pas DDE.

chrisnapoli
12 juin 2018 à 21:34

non le timer copie les cotations toutes les minutes il sert seulement pour alimenter mes données statistiques
les graphes sont alimentes directement par les dde en instantanée

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
12 juin 2018 à 21:51

alors on pourrait tenter de faire Worksheet_Change dans l'onglet contenant les données fournies par le dde.

Réponse 9 / 14

Chrisnapoli
13 juin 2018 à 09:42

oui je comprends bien ce que tu veux me dire
alors si au lieu de mettre dans le code la condition OK,on mettait les criteres du MAX des plages qui sont inscrit dans d autres cellules
(puisque eux ils changent )
lorsqu' ils atteindront le critère inscrit dans la formule alors peur être que le changement se fera automatiquement
on dirait pour les plages

BO101:BW141;BO144:BW184;BO187:BW227;BO230:BW270;BO273:BW313

condition1
SI(BY101>0,0175)
condition 2
SI(ET(BY144>0,014;BY144<=0,0175)
Condition3
SI(ET(BY187>0,009;BY187<=0,014)
Condition4
SI(ET(BY230>0,005;BY230<=0,009)
Condition5
SI(ET(BY273>=0;BY273<=0,005)

etc pour les autres plages...

. de quelle maniére inscrire ces formules a la place des OK????

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 juin 2018 à 17:05

le soucis, c'est de déclencher le code, donc pas utile de modifier le contenu du code.
pour le déclencher, on peut utiliser
soit un timer,
soit Worksheet_Change, si on trouve des cellules qui changent vraiment (qui déclenchent Worksheet_Change)
soit (je vais regarder si cela a du sens) via Worksheet_Calculate()

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024
13 juin 2018 à 17:21

à première vue, Worksheet_Calculate() me semble une bonne option, cela déclenche quand une fonction de la feuille est réévaluée (peut-être trop souvent, on verra).
pour tester, ajouter dans la feuille:

Private Sub Worksheet_Calculate()
call RecopiePlage() 
End Sub

Réponse 10 / 14

Chrisnapoli
13 juin 2018 à 13:07

est ce que tu peux me corriger mon code je ne sais pas de quelle façon cela s’écrit?????? (elles se mettent en rouge, je ne dois pas respecterle mode d'ecriture sans doute...)
après j essayerais
les cellules prises en compte ,cette fois ne sont pas inertes elles correspondent au max de chaque plage donné en temps réel

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True

If [AY101] <-0,0175" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AY144] <-0,014 ; [AY144] >=-0,0175 Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AY187] <-0,009 ; [AY187]>=-0,014 Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AY230] <-0,005 ; [AY230] >=-0,009Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AY273] <0 ; [AY273] >)-0,005 Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BY101] >0,0175 Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BY144] >0,014 ; [BY144] <=0,0175 Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BY187] >0,009 ;[BY187]<=0,014 Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BY230] >0,005 ; [BY230]<=0,009Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BY273] >= 0 ; [BY273] <=0,005Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AY316] <=0,0175 Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AY359] <-0,014 ; [AY359] >=-0,0175 Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AY402] <-0,009 ; [AY402] >=-0,014Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AY445] <=0,005 ; [AY445] >=-0,009 Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AY488] <0 ; [AY488] >=-0,005 Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BY316] > 0,0175 Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BY359] >0,014 ; [BY359] <=0,0175 Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BY402] >0,009 ;[BY402] <=0,014 Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BY445] >0,005 ; [BY445] <=0,009 Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BY488] >=0 ; [BY488] ;<=0,005 Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 juin 2018 à 16:27

en VBA, toujours des points décimaux, je pense

[AY101] <-0.0175

au lieu de:
[AY488] <0 ; [AY488] >=-0,005
probablement

[AY488] <0 and [AY488] >=-0.005

chrisnapoli
13 juin 2018 à 16:50

bon je vais essayer
que veux tu dire par je voulais ecrire le resultat de la formule?? parceque le resultat est constemment en mouvement....

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
13 juin 2018 à 17:24

je voulais corriger mon texte précédent:
on a essayé d'activer le code quand les cellules "ok" changeaient, en utilisant Worksheet_Change, mais cela n'a pas déclenché parce que les cellules ne changent pas, c'est juste le résultat de la formule qui change.

Réponse 11 / 14

chrisnapoli
13 juin 2018 à 17:19

il y en a un qui m a dit de mettre ca dans la feuille
Private Sub Worksheet_Calculate()
Call RecopiePlage
End Sub et de garder le code recopieplage dans le module

j ai essaye ca marche mais le probleme est que ca tourne en boucle et ca copie sans interruption
alors quil faudrait que ca copie des que un ok a change de cellule et que la copie ne se fasse que une fois
ainsi le pas reste le meme tant que le Ok n a pas change a nouveau de cellule

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 juin 2018 à 17:32

RecopiePlage() est toujours comme en #22?
je pense qu'on peut l'améliorer pour ne faire la copie que quand un "ok" change.

Réponse 12 / 14

chrisnapoli
13 juin 2018 à 17:47

oui je mets le code que je veux
ca donne le même résultat avec l'ancien et le nouveau c'est exactement pareil je suis oblige d actionner la macro manuellement avec le bouton
si tu dits qu on peut l améliorer c'est daccord mais il faut qu il copie des qu'un des 4 Ok change et qu'il copie une seule fois tant que aucun autre changement n 'est détectée parceque sinon ca va faire comme je t ai dit tourner sans arrêt en boucle et c'est pas bon

Réponse 13 / 14

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 juin 2018 à 17:53

pour gagner un peu de temps, nouvelle sub linkrg:

Private Sub linkrg(Target As Range, source As Range)
Application.ScreenUpdating = False
source.Copy
Target.Parent.Activate
Target.Select
Target.Parent.Paste Link:=True
Target.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

je propose ceci pour éviter de recopier tout le temps tout, ceci ne devrait plus recopier la première série que quand un "ok" y change. si c'est bon, j'adapte pour les trois séries suivantes:

Sub RecopiePlage()
Static ax1 As Integer

If [AX101] = "Ok" Then
    If ax1 <> 101 Then
        Call linkrg([CK11:CS51], [BA101:BI141])
        ax1 = 101
    End If
ElseIf [AX144] = "Ok" Then
    If ax1 <> 144 Then
        Call linkrg([CK11:CS51], [BA144:BI184])
        ax1 = 144
    End If
ElseIf [AX187] = "Ok" Then
    If ax1 <> 187 Then
        Call linkrg([CK11:CS51], [BA187:BI227])
        ax1 = 187
    End If
ElseIf [AX230] = "Ok" Then
    If ax1 <> 230 Then
        Call linkrg([CK11:CS51], [BA230:BI270])
        ax1 = 230
    End If
ElseIf [AX273] = "Ok" Then
    If ax1 <> 273 Then
        Call linkrg([CK11:CS51], [BA273:BI313])
        ax1 = 273
    End If
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub

chrisnapoli
14 juin 2018 à 09:16

Bonjour
j ai fait les essais ce matin rien ne se passe c'est desesperant

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
14 juin 2018 à 09:25

peux-tu utiliser plutôt les deux nouveaux sujets de discussion que tu viens de créer?

Réponse 14 / 14

chrisnapoli
13 juin 2018 à 19:34

j ai mis le code comme ceci dans le module matin je verrais si ca marche demain matin

Private Sub linkrg(Target As Range, source As Range)
Application.ScreenUpdating = False
source.Copy
Target.Parent.Activate
Target.Select
Target.Parent.Paste Link:=True
Target.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub RecopiePlage()
Static ax1 As Integer

If [AX101] = "Ok" Then
If ax1 <> 101 Then
Call linkrg([CK11:CS51], [BA101:BI141])
ax1 = 101
End If
ElseIf [AX144] = "Ok" Then
If ax1 <> 144 Then
Call linkrg([CK11:CS51], [BA144:BI184])
ax1 = 144
End If
ElseIf [AX187] = "Ok" Then
If ax1 <> 187 Then
Call linkrg([CK11:CS51], [BA187:BI227])
ax1 = 187
End If
ElseIf [AX230] = "Ok" Then
If ax1 <> 230 Then
Call linkrg([CK11:CS51], [BA230:BI270])
ax1 = 230
End If
ElseIf [AX273] = "Ok" Then
If ax1 <> 273 Then
Call linkrg([CK11:CS51], [BA273:BI313])
ax1 = 273
End If
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW402])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW445])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW488])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
End Sub

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 juin 2018 à 20:59

peux-tu utiliser plutôt les deux nouveaux sujets de discussion que tu viens de créer?

Discussions similaires

Problème d'allumage écran LG : "OUT OF RANGE"

Comment brancher un JBL SUB 200/230

D-sub coupure

SOS écran bleu "out of range H:75KHZ V :60HZ

D-sub no signal entering the power saving mod

Discussions similaires

Newsletters