afficher des plages de cotations sous conditions

Question

Bonjour,  
je n arrive toujours pas a solutionner ce casse tète 
j ai une macro qui m affiche plusieurs plages  vers 2 graphes sous condition
 cette macro s’exécute par Bouton; elle fonctionne parfaitement ; mais je voudrais qu elle s’exécute automatiquement d 'elle même je mets le code en dessous 
j ai vu que certains font tourner en  boucle une macro qui copie les formule et le format sous condition et qui balaie en même temps chaque fois que la condition change ,ce n 'est pas exactement ce que je voulais faire,mais si il n ya pas d 'autres solution alors j adopterais celle ci
 je mets le code en dessous  de ma macro actuelle (je désire qu elle s’exécute automatiquement)
Merci de votre aide

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
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

Configuration: Windows / Chrome 67.0.3396.87
        EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

gbinforme · Answer

Bonjour, 

a priori tu n'as besoin d'exécuter ta macro que si tu changes des données dans ta feuille alors avec cette macro tu n'auras plus besoin de bouton :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [BA101:BW528]) Is Nothing Then Call RecopiePlage
End Sub
 
Bien sûr tu peux adapter en précisant avec Intersect les plages concernées.

Chrisnapoli · Answer

Comme ceci????

Private Sub Worksheet_Calculate()
    Call RecopiePlage

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
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

Chrisnapoli · Answer

autrement dit il faut que la copie se fasse une seule fois par cellule qui contiennent les OK
 il ya 20 cellules qui peuvent recevoir les OK mais seulement 4 qui les affichent donc si un seul des ok change de destination de cellule il faut que instantanément la copie de la plage se fasse  mais une seule fois ( jusqu a ce que a  nouveau une autre destination est detectée
 je ne sais pas si tu vas comprendre le but de ce code

chrisnapoli · Answer

Bonjour 

je suis revenue a mon code de départ qui fonctionne très bien avec un bouton je ne suis pas un programmeur je le répète,mais il me semble que si un premier code permet d'afficher en mode valeur les  4 OK vers des cellules  a cote ;il peut y avoir a lors un autre  code  qui va actionner la macro recopieplage 
un premier code qui dirait grosso modo si les cellules abcd etc sont égale à "OK"; copier les en mode valeur vers les cellules .......
un deuxieme qui dit des qu 'une des 4 cellules contenant OK passe à ("") executer la macro recopieplage





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
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

chrisnapoli · Answer

ya un truc que je pige pas  explique moi pourquoi on peut pas faire un code qui dit si la cellule un tel est compris  entre un chiffre et ce chiffre actionner moi la macrocopie plage une seule fois;si la cellule un tel est comprise entre un chiffre et ce chiffre actionner moi la macro recopieplage une seule fois ......etc
 ca dépasse tout entendement on complique les choses la ou elles sont simples y a des choses bien plus compliquées que celle la qui ont été faite sans se prendre le teston

chrisnapoli · Answer

ça c'est la réponse de quelqu'un qui ne connait pas la solution et qui ne la trouvera jamais 
je ne suis pas inquiet je suis persuade que c'est faisable ,c'est une macro sous condition
petit a petit je vais apprendre  rien n'est impossible

chrisnapoli · Answer

Bonsoir 
je viens de voir ton code  je ne peux que l 'essayer 
je n ai pas assez de connaissance dans le domaine pour le commenter 
 demain après midi je serais fixé 
le matin je vais avoir certaines occupations qui m empêcheront de me servir du temps réel
je suppose que si tu m 'as répondu ainsi c'est que tu es sur de ton coup
 si ca marche j espère que tu me donneras la logique de tous ces signes..... qui ne sont pour moi aujourd’hui que du chinois  mais le chinois comme toutes langue cela s'apprend avec beaucoup de temps et de volonté

Chrisnapoli · Answer

bonjour 
jre viens juste de renter  j ai essaye le code ca ne fonctionne pas du tout alors je vais essayer de remplacer en partie par la propostionde Ygbe 
on verra

Chrisnapoli · Answer

re je viens d'essayer a nouveau mais malgre ce nouveau code il n y rien qui fonctionne

Chrisnapoli · Answer

oui j ailu mais c'est pas du tout clair 
Un simple clic sur l'icone insère les balises "génériques", sans indication de langage, et donc sans coloration associée. Selon le langage et la capacité du site à le reconnaitre le rendu peut être loin de celui espéré.

Chrisnapoli · Answer

le probleme il est pas dans la couleur du code

Chrisnapoli · Answer

mais comment veux tu maîtriser tellement que c'est mal explique il n y a a aucun endroit marqué comment tu dois faire pour colorier le code je le vois nulle part 
moi je crois que le plus important c'est de savoir ou je mets le code qui gêne le sien dans la feuille sinon on va jamais y arriver

Chrisnapoli · Answer

je t'explique on va prendre par exemple quelques cellules qui contiennent ou pas le Ok (cellule BZ101)
la formule est la suivante=SI(BY101>0,0175;"OK";"")
dans BY101 tu as =MAX(BO102:BW141)

Dans BZ 144 la formule est la suivante =SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
BY144 tu as =MAX(BO145:BW184)

Dans BZ 187la formule est la suivante
=SI(ET(BY187>0,009;BY187<=0,014);"OK";"")
BY187 tu as =MAX(BO188:BW227)

Dans BZ 230la formule est la suivante
=SI(ET(BY230>0,005;BY230<=0,009);"OK";"")
BY230 tu as =MAX(BO231:BW270)

Dans BZ 273la formule est la suivante
=SI(ET(BY273>=0;BY273<=0,005);"OK";"")
BY273 tu as =MAX(BO274:BW313)

etc... le OK est donne par rapport au Max des plages contenue dans ces cellules bypour celles la et de l autre cote c'est AY et les OK sont en AX
selon que le Max correspond aux criteres exiges en BZ les ok sinscrivent a leur places il ya 2 ok de chaque cote par graphe

Chrisnapoli · Answer

Bonjour
 tout simplement je sélectionne la plage et je rentre le MAX de la plage donc le changement se fait automatiquement par la fonction MAX en temps réel pour ton information ,j étais arrivé à solutionner le problème seulement avec des formules mais j avais un soucis parce que lorsque tu incrémentes trop de formules par cellule excel te renvoie la valeur en nombre entier à plusieurs décimales et il est impôssible de ramener le format en pourcentage j étais oblige de faire 20 plages supplémentaires pour multiplier toutes les cellules par1 afin d avoir le bon format en % mais la aussi ce n était pas une bonne solution parce que lorsque j'ouvrais mon fichier cela mettait un temps infini a s'ouvrir(je ne sais pas pourquoi??sinon le graphe marchait la procédure des OK étaient respecte automatiquement

au départ le graphe fonctionnait parfaitement bien mais sur une seule échelle
0,25%	0,50%	0,75%	1,00%	1,25%	1,50%	1,75%	2,00%	>2,00%



 j ai fait ceci pour rendre les graphes plus   
dynamiques il y a 20 plages 10 plages par graphes 5 de positives a droite (vert)pour les barres de droite et 5 de négatives  pour les barres de gauche(rouges) la première échelle(la plus petite) est de

0,05%	0,10%	0,15%	0,20%	0,25%	0,30%	0,35%	0,40%	>0,40%
puis
0,10%	0,20%	0,30%	0,40%	0,50%	0,60%	0,70%	0,80%	>0,80%
puis
0,15%	0,30%	0,45%	0,60%	0,75%	0,90%	1,05%	1,20%	>1,20%
puis
0,20%	0,40%	0,60%	-0,80%	1,00%	1,20%	1,40%	1,60%	>1,60%
puis
0,25%	0,50%	0,75%	1,00%	1,25%	1,50%	1,75%	2,00%	>2,00%
pareil mais inverse pour le cote negatif
-0,40%	-0,35%	-0,30%	-0,25%	-0,20%	-0,15%	-0,10%	-0,05%
etc........
chaque fois que un max de la plage dépasse le critère annoncé dans la cellule ou se trouve le ok on saute de un pas ou on recule de un pas, c'est suivant(ne s’affiche sur le graphe que les plages qui contiennent les ok donc 4 plages maxi 
2 pour chaque graphe une pour le positif l autre pour le négatif 
ce sont tout simplement des barres de progression Horizontales et au milieu une colonne avec les noms des 40 valeurs du Cac 40

Chrisnapoli · Answer

re
 j ai oublie de te dire  au final c'est laf onction Max qui donne le chiffre contenue dans BY et ce chiffre varie parce que le temps réel arrive sur le fichier par une API qui donne instantanément le cours de l action automatiquement

Chrisnapoli · Answer

L obstination et la bonne volonté finissent toujours par payer
 je viens d'essayer 
première des choses, hier j avais remis mon ancien code qui marchait avec le bouton 
 en fin de journée  jai  fait quelques manip du bouton puis j ai ferme mon fichier  une heure avant la fin de séance
 a ce moment la ,toutes les plages étaient au max(la dernière barre), sauf une qui était sur un pas différent (en dessous)
 donc quand j ai ouvert le fichier aujourd’hui j'ai pris bien soin de regarder je n ai pas activé le logiciel qui me fournit le temps réel(car il aurait mis les cotations a jour)
 j ai rentre ton  nouveau code puis j'ai fermé le fichier puis réouvert avec le logiciel et la mise à jour des cotations  de fin de journée
et la, miracle la barre qui était à l' Echelle en dessous s'est mis a la bonne échelle'( puisque le cours de séance en fin de journée et toutes les plages étaient hier soir sur échelle Maximum
donc apparemment ton nouveau code marche a vérifier lundi avec le temps réel en action mais je pense que cela va marcher(aujourd’hui les bourses ne marchent pas)

le seul problème ,c'est que en fin de procédure la plage du 2eme graphe était grise par  sélection et les graphes n étaient pas revenue a la ligne 12 de départ ils avaient bougé un peu vers le bas  j ai rajoute ce bout de code et apparemment cela marche tout revient a la position de départ

Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row 

""Félicitation"" je pense que tu  as trouvé la bonne solution (nous verrons Lundi)
Peux tu me dire si je peux te consulter à nouveau pour mes 3 derniers problème( si tu as le temps)  un est lie directement avec ce que tu viens de trouver(mais je ne sais pas si il sera possible de solutionner mon désir (parce que apparemment c'est extrêmement complexe)
 les 2 autres sont lie a un timer que m a fait YGB avec succès et que je veux rendre plus performant 
après c'est termine j aurais ouvert mon site web et vous serez les premiers a le consulter

chrisnapoli · Answer

Bonjour
voila mon second soucis
j ai un timer qui me relève les cotations toute les minutes de la journee j ai un timer qui marche très bien sur un seul marché
donc j ai essaye de le dupliquer sur 4 marchés sur le même fichier sur 4 feuilles différentes les marches démarrant et se terminant a la même heure seules la nature des cotations est differente je ne sais pas pourquoi le deuxieme fichier ne fonctionne pas, je ne sais pas d'ou vient l 'erreur dans le code??
je mets les 2 codes en dessous le premier marche
dans woorkbooksheet j ai

Option Explicit

Private Sub Workbook_Open()
    Sheets("statist").Select
    c = 383
    Application.OnTime TimeValue("09:01:00"), Procedure:="RecupCotation" '"09:01:00"
    'Range("NR12:AHW131").ClearContents
End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets("statist")
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub
dans module1 j ai
  Public Durée As Date
    Public c

Sub RecupCotation()
    Durée = Now + TimeValue("00:01:00") ' A remplacer par "00:01:00"
    Application.OnTime Durée, "RecupCotation"
    Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
    c = c + 1
    If c >= 908 Then ArretCotation 'N° de la dernière colonne
End Sub


Sub ArretCotation()
    On Error Resume Next
    Application.OnTime Durée, "RecupCotation", , False
End Sub

  Public Durée1 As Date
    Public c As Long
    Public TempsInitial1 As Date
    Public TempsInitial1Num As Double
    Public T1
    Public Tempo1

Sub RecupCotation1()
    If T1 >= 60 Then T1 = 0 '60
    Durée1 = Format(TempsInitial1Num + (T1 * Tempo1), "hh:mm:ss")
    Application.OnTime Durée1, "RecupCotation1"
    Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
Dim l As Long
For l = 12 To 51
    If Cells(l, "C").Value <> "ok" Then
        If Cells(l, "D").Value <> Cells(l, "AS").Value _
            Or Cells(l, "E").Value <> Cells(l, "AT").Value _
            Or Cells(l, "F").Value <> Cells(l, "AU").Value _
            Or Cells(l, "G").Value <> Cells(l, "AV").Value _
            Or Cells(l, "H").Value <> Cells(l, "AW").Value Then
            Cells(l, "C").Value = "ok"
        Else
            Cells(l, c).ClearContents
            Cells(l + 40, c).ClearContents
            Cells(l + 80, c).ClearContents
        End If
    End If
Next l
    Application.Wait Now + TimeValue("00:00:01")
    TempsInitial1Num = TempsInitial1Num + Tempo1
    If c >= 908 Then ArretCotation1 'N° de la dernière colonne des cotations à la minute
    c = c + 1
End Sub
Sub ArretCotation1()
    On Error Resume Next
    Application.OnTime Durée1, "RecupCotation1", , False
End Sub
dans module6 j ai
Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets(feuille)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub

Pour le deuxième fichier avec les 4 feuilles j ai dans this workbook

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub

Private Sub Workbook_Open()
init_marches
End Sub

puis dans module 1 j' ai

Option Explicit
    Public Durée As Date
    Public c

Sub RecupCotation()
    Durée = Now + TimeValue("00:01:00") ' A remplacer par "00:01:00"
    Application.OnTime Durée, "RecupCotation"
    Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
    c = c + 1
    If c >= 908 Then ArretCotation 'N° de la dernière colonne
End Sub


Sub ArretCotation()
    On Error Resume Next
    Application.OnTime Durée, "RecupCotation", , False
End Sub

  Public Durée1 As Date
    Public c As Long
    Public TempsInitial1 As Date
    Public TempsInitial1Num As Double
    Public T1
    Public Tempo1

Sub RecupCotation1()
    If T1 >= 60 Then T1 = 0 '60
    Durée1 = Format(TempsInitial1Num + (T1 * Tempo1), "hh:mm:ss")
    Application.OnTime Durée1, "RecupCotation1"
    Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
Dim l As Long
For l = 12 To 51
    If Cells(l, "C").Value <> "ok" Then
        If Cells(l, "D").Value <> Cells(l, "AS").Value _
            Or Cells(l, "E").Value <> Cells(l, "AT").Value _
            Or Cells(l, "F").Value <> Cells(l, "AU").Value _
            Or Cells(l, "G").Value <> Cells(l, "AV").Value _
            Or Cells(l, "H").Value <> Cells(l, "AW").Value Then
            Cells(l, "C").Value = "ok"
        Else
            Cells(l, c).ClearContents
            Cells(l + 40, c).ClearContents
            Cells(l + 80, c).ClearContents
        End If
    End If
Next l
    Application.Wait Now + TimeValue("00:00:01")
    TempsInitial1Num = TempsInitial1Num + Tempo1
    If c >= 908 Then ArretCotation1 'N° de la dernière colonne des cotations à la minute
    c = c + 1
End Sub
Sub ArretCotation1()
    On Error Resume Next
    Application.OnTime Durée1, "RecupCotation1", , False
End Sub

puis dans module 6 j'ai

Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets(feuille)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub

Puis dans module 8 j ai

Option Explicit

Dim marches() As Worksheet

Sub copy_dh()
Dim marche As Variant
Dim fl As Worksheet
For Each marche In marches
Set fl = marche
    Call copy_dhfl(fl)
Next marche
End Sub
Private Sub copy_dhfl(sh As Worksheet)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub
Sub init_marches()
ReDim marches(3)
Set marches(0) = Sheets("CAC40")
Set marches(1) = Sheets("AEX")
Set marches(2) = Sheets("BEL20")
Set marches(3) = Sheets("PSI20")
End Sub

chrisnapoli · Answer

Bonjour  
tu parles du code pour le timer avec 4 feuilles???? 
et pour ce qui est du module 8 est ce que l ecriture est correcte

Option Explicit

Dim marches() As Worksheet

Sub copy_dh()
Dim marche As Variant
Dim fl As Worksheet
For Each marche In marches
Set fl = marche
    Call copy_dhfl(fl)
Next marche
End Sub
Private Sub copy_dhfl(sh As Worksheet)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub
Sub init_marches()
ReDim marches(3)
Set marches(0) = Sheets("CAC40")
Set marches(1) = Sheets("AEX")
Set marches(2) = Sheets("BEL20")
Set marches(3) = Sheets("PSI20")
End Sub

chrisnapoli · Answer

comment faire pour qu la procedure qui copie AS12, :AW51 en D12:H51 de se fasse  aussi sur les 4 feuilles.??? dans thisworkbook

Option Explicit
Private Sub Workbook_Open()
Sheets("CAC40").Select
c = 383
Application.OnTime TimeValue("09:01:00"), Procedure:="RecupCotation" '"09:01:00"
'Range("NR12:AHW131").ClearContents
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
Set sh = Sheets("CAC40")
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub

chrisnapoli · Answer

Bonjour
 seul le code pour une feuille marche parfaitement celui de 4 feuilles ne marche pas du tout je ne sais pas pourquoi c'est trop compliqué pour moi

chrisnapoli · Answer

le probleme est que tu me parles comme si je connaissais la programmation 
 moi jai de la facilite a trouver des logiques et creer des applications mais je ne connais absolument rien au langage
 alors j ai du mal d'autant que je pige pas que tu ai mis statist dans sheet alors que cela concerne seulement le premier code qui marche deja 
moi c'est le deuxieme que je veux solutionner alors j ai un peu d mal a comprendre quand tu marque feuilles avec rien dedans je sais pas si il me faut mettre les quatres feuilles ou seulement la premiere 
de plus ne connaissant pas les signes je vois pas très bien comment cela pourrait fonctionner il faut que tu me dises ou je faits mes erreurs 
aussi tu me parles de baniere de code je ne sais même pas de quoi tu me parles 
effectivement j ai vu un bouton qui pour toi est évident ,mais encore une fois pas pour moi je te mets les codes tels que je les ai ecrit
si tu veux me corriger tu le faits sinon tant pis j irai voir un devellopeur

<Option Explicit
Private Sub Workbook_Open()
Sheets("CAC40,AEX,BEL20,PSI20").Select
c = 383
Application.OnTime TimeValue("16:16:00"), Procedure:="RecupCotation" '"09:01:00"
'Range("NR12:AHW131").ClearContents
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Const ndf = "CAC40,AEX,BEL20,PSI20"
Dim marches, marche
Dim sh As Worksheet
    marches = Split(ndf, ",")
    For Each marche In marches
        Set sh = Sheets(marche)
        sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
        sh.Range("C12:C51").ClearContents
        sh.Range("C11") = Now
    Next marche
End Sub
Option ExplicitDim marches() As StringSub init_marches()ReDim marches(3)    marches(0) = "CAC40"    marches(1) = "AEX"    marches(2) = "BEL20"    marches(3) = "PSI20"End SubSub copy_dh1()Dim sh As Worksheet    Set sh = Sheets(CAC40, AEX, BEL20, PSI20)     sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value    sh.Range("C12:C51").ClearContents    sh.Range("C11") = NowEnd SubSub copy_dh()Dim marche As VariantDim fl As Worksheet    For Each marche In marches        Set fl = Sheets(marche)        Call copy_dhfl(fl)    Next marcheEnd SubSub copy_dhfl(sh As Worksheet)    sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value    sh.Range("C12:C51").ClearContents    sh.Range("C11") = NowEnd Sub<code>Private Sub Workbook_BeforeClose(Cancel As Boolean)copy_dhEnd SubPrivate Sub copy_dh()Dim sh As WorksheetSet sh = Sheets(feuille)sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Valuesh.Range("C12:C51").ClearContentssh.Range("C11") = NowEnd Sub

chrisnapoli · Answer

de quel bouton????
je ne peux pas deviner c'est très mal explique j ai cliqué sur le bouton ou est inscrit code et ya ca qui se met >code
après je ne sais pas ou faut il le mettre et de quelle manière
pour les codes il n ya que le code du timer qui fonctionne l 'autre ne colle rien je ne sais pas si il est bien ecrit  si il faut specifier les 4 feuilles la ou tu as mis sheets
 c'est vraiement la devinette...?pour quelqu un qui ne connait pas c'est pourtant pas sorcier d'expliquer les choses clairement

gbinforme · Answer

Bonjour, 

y a ca qui se met >code après je ne sais pas ou faut il le mettre 
Il me semble que tu veux faire un site internet ? sans avoir la moindre idée du code HTML ? étonnant non ?

 l 'autre ne colle rien quel autre code ? celui qui fonctionnait vendredi ?

c'est vraiement la devinette...?
Là tu as parfaitement raison et comme ma boule de cristal est en panne je ne comprends pas du tout ce que tu veux...

Le plus simple serait que tu anonymises ton classeur et que tu le mettes sur un lien avec le code que tu as et que tu dises ce qui ne te donnes pas satisfaction.

chrisnapoli · Answer

Bonjour 
le site est pratiquement finie malgré ce que tu peux penser 
 ce que je suis entrain de faire n 'est que de l amélioration parce que je cherche a faire un outil parfait 
la connaissance du langage n 'est pas un très grand problème pour moi(la preuve) des que j ai tout fini je te donnerais la possibilité de voir mon travail fini
le plus important a été de trouver la logique et la structure de mon logiciel 
je ne m inquiète pas du tout l autre jour tu m 'as envoyé un code qui ne marchait pas et apres avoir un peu pesté après moi tu m 'as trouvé la solution derrière....
 pour la transcription il y a des gens compétents comme toi qui trouvent toujours les solutions pour transformer ma logique
la preuve en est c'est que le develloper qui me transforme mon VBA en java script connait tres peu le VBA mais avec un peu de patiente a su metter en pratique exactement ce que je voulais dans le WEB

 moi a mon age c'est un peu complique de vouloir apprendre à coder c'est trop long et j ai pas de temps pour cela je préfère me consacrer à inventer des choses et les commercialiser 
je t'envoie le fichier en question celui qui colle les cotations sur 4 feuilles j ai mis accessoirement les 4 mêmes liens dde sur chaque feuille tout simplement parce que je n ai pas encore d'API et je me sert d'un logiciel qui ne peut pas copier 4 listes de liens DDE dans le même temps 
ça me permet  tout de même de voir si le systeme copie les 4 marches en même temps 
les horaires de marchés étant les mêmes ,plus tard il me suffira d adapter l API a chaque feuille
 quand tu vas ouvrir le document tu vas avoir une fenêtre qui t interroge pour mettre a jouer les liaisons tu cliques sur rien tu vas sur la croix et tu fermes cette fenêtre
https://cjoint.com/c/HFujz35kbnt

gbinforme · Answer

Bonjour,

Bon j'ai ouvert le mastodonte de 101,6 Mo - là c'est du classeur ! ;-)

 profite en pour regarder ce qui ne fonctionne pas dans ce code j ai absolument rien qui se colle dans ce code 

J'en ai donc profité pour regarder et voir que tu n'avais pas mis la macro de copie sur passage à "ok" mais bon c'est toi le chef et donc tu fais ce que tu veux !

Ensuite j'ai fermé le classeur et j'ai constaté que "ce code qui ne fonctionne pas"  était tout à fait opérationnel.
Bien sûr il faut ré-ouvrir le géant pour voir le résultat puisque tu fais tes copies à la fermeture et donc tu n'as pas le temps de le voir. Tu pourras alors constater que les copies ont été faites et que C11 sur les 4 feuilles indique  ton heure de fermeture.

ce que je suis entrain de faire n 'est que de l amélioration parce que je cherche a faire un outil parfait 
Si je suis la phrase de St-Ex ci-dessous je pense qu'il y a encore pas mal de choses à "retirer"...

gbinforme · Answer

Bonjour, 
 
 moi je n ai aucune de ces cotations qui se collent 
Il te faudra regarder de plus prêt et l'heure de fermeture n'y est pas non plus alors ? ;-)

 dits moi au moins si mon probleme ne vient pas de la
Je ne sais pas de quel problème tu parles mais si c'est pour faire fonctionner le timer sur chaque feuille il faut modifier la procédure "RecupCotation" et non faire ta modification qui ne sert qu'à sélectionner tes 4 feuilles.

Si tu veux poser du code n'importe comment sans savoir le fonctionnement l'on est pas prêt d'avoir un classeur fonctionnel.

chrisnapoli · Answer

Grand Merci cela marche parfaitement maintenant ;je viens d'essayer , tu es un champion....
 par contre
 j ai un conflit sur le code que tu m 'as réalisé l autre jour 
le processus des OK change parfaitement le pas, les plages s'affichent au bon endroit les graphes tournent en temps réel, tout se fait automatiquement mis a part que toutes les secondes le sablier bleu s'enclenche  (comme si le fichier s'enregistrait sans interruption)et perturbe le systeme ,ce qui fait  que quand je me sert des autres macros pour passer d'un graphe a l autre c'est impossible parce que ca me ramène tout le temps immediatement sur le premier graphe on dirait que quelque chose tourne en boucle??? as tu une idée de la cause????

chrisnapoli · Answer

Bonjour 
Attention de ne pas confondre les problèmes,  la procédure des OK sur le  fichier 4 feuilles n y est plus parce que je ne sais pas ou la mettre exactement a part ca le classeur marche très très bien  j ai un classeur beaucoup plus gros que celui la, qui marche aussi parfaitement  
donc il faut répondre a ma question ,
ou mettre et de quelle manirère intégrer la procédure que m avait fait YGBE  pour que les cotations s'effacent tant que le cours d'ouverture n 'est pas enregistré sur une valeur (ceci était fait pour le classeur  une feuiile maintenant il faut l adapter au classeur 4 feuilles (je ne sais pas comment???)

pour le deuxième problème  il n 'est absolument pas lié au gros fichier puisque c'est un autre fichier independant

 le problème des oK n 'est pas du tout le même cela concerne le code qui me permet d'afficher plusieurs  plages il n 'est pas associe au classeur 4 feuilles 'cela n 'a rien a voir  c'est un problème a mon avis de quelque chose qui tourne en boucle dans ton code- sinon le code remplit sa fonction
 le seul ennui c'est que sans arrêt le sablier enregistrement semble en marche et cela m empêche de me servir d'une macro qui me fait remonter le deuxième graphe a l 'écran

encore une fois ces 2 fichiers sont complètement différents  et même si j ouvre le fichier ou est ce problème sans que l 'autre fonctionne le sablier est toujours présent
par contre si je garde ce fichier en enlevant ton code et en revenant a la source au tout premier graphe que j avais créé(sans avoir de plages a copier )le problème du sablier disparaît je mets le code que tu m'as fait et qui a ce problème de sablier en dessous

Private Sub worksheet_Calculate()
Const cok = "AX101,AX144,AX187,AX230,AX273,BZ101,BZ144,BZ187,BZ230,BZ273,AX316,AX359,AX402,AX445,AX488,BZ316,BZ359,BZ402,BZ445,BZ488"
Const cpo = "CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97"
Const cpd = "BA101:BI141,BA144:BI184,BA187:BI227,BA230:BI270,BA273:BI313,BO101:BW141,BO144:BW184,BO187:BW227,BO230:BW270,BO273:BW313,BA316:BI356,BA359:BI399,BA402:BI442,BA445:BI485,BA488:BI528,BO316:BW356,BO359:BW399,BO402:BW442,BO445:BW485,BO488:BW528"
Dim elk, elo, eld, idc As Integer
Static avd(20)
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    elk = Split(cok, ","): elo = Split(cpo, ","): eld = Split(cpd, ",")
    For idc = 0 To UBound(elk)
        If LCase(avd(idc)) <> "ok" And LCase(Range(elk(idc)).Value) = "ok" Then
            Range(eld(idc)).Copy
            Range(elo(idc)).Select
            Range(elo(idc)).Parent.Paste link:=True
        End If
        avd(idc) = Range(elk(idc)).Value
    Next idc
    Application.Calculation = xlCalculationSemiautomatic
    Application.EnableEvents = True
    Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row

End Sub

chrisnapoli · Answer

non je viens de l enlever et le sablier est toujours actif 
par contre peux tu me dire ou je doit mettre la procédure des OK(qui effaçait les valeurs tant que le cours d'ouverture n était pas donné) dans le code qu a fait gbinforme pôur le Timer 4 feuilles

chrisnapoli · Answer

DE quelle manière cela doit être adapté pour aller dans le module 1???? 
et pour l'autre problème ca ne marche pas j ai enlevé ce que tu m as dits 21 et22 en 82 et j ai toujours le sablier qui marche?????

chrisnapoli · Answer

comme ceci??? basic Option Explicit Public Durée As Date Public c As Long Dim l As Long Public Const ndf = "CAC40,AEX,BEL20,PSI20" Sub RecupCotation() Dim marches, marche marches = Split(ndf, ",") For Each marche In marches With Sheets(marche) .Cells(12, c).Resize(120, 1) = .Range("A12:A131").Value Dim l As Long For l = 12 To 51 If Cells.l, "C").Value <> "ok" Then If Cells.(l, "D").Value <> Cells.(l, "AS").Value _ Or Cells.(l, "E").Value <> Cells.(l, "AT").Value _ Or Cells.(l, "F").Value <> Cells.(l, "AU").Value _ Or Cells.(l, "G").Value <> Cells.(l, "AV").Value _ Or Cells.(l, "H").Value <> Cells.(l, "AW").Value Then Cells.(l, "C").Value = "ok" Else Cells.(l, c).ClearContents Cells.(l + 40, c).ClearContents Cells.(l + 80, c).ClearContents End If End If >

chrisnapoli · Answer

ok mais le probleme du sablier qui tourne en permanence c'est quoi qui fait cela ??
c'est bien cela qui empeche le graphe d’exécuter la macro de positionnement sur le graphe du haut

chrisnapoli · Answer

en fait je crois que le sablier tourne en permanence tout simplement parceque le code qu a fait gbinforme colle en permanence les plages correllées directement aux OK 
alors quil  ne  devarit coller qu'une seule fois et ne coller à nouveau que si il y a  un nouveau changement détecté dans une des 4 cellules

yg_be · Answer

correction, teste plutôt ceci, sinon la procédure ne s'exécute qu'une seule fois:
Private Sub worksheet_Calculate()
Const cok = "AX101,AX144,AX187,AX230,AX273,BZ101,BZ144,BZ187,BZ230,BZ273,AX316,AX359,AX402,AX445,AX488,BZ316,BZ359,BZ402,BZ445,BZ488"
Const cpo = "CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97"
Const cpd = "BA101:BI141,BA144:BI184,BA187:BI227,BA230:BI270,BA273:BI313,BO101:BW141,BO144:BW184,BO187:BW227,BO230:BW270,BO273:BW313,BA316:BI356,BA359:BI399,BA402:BI442,BA445:BI485,BA488:BI528,BO316:BW356,BO359:BW399,BO402:BW442,BO445:BW485,BO488:BW528"
Const freq As Single = 1 / 24 / 60 / 4 ' un quart de minute
Dim elk, elo, eld, idc As Integer, sss As Range, maint As Date
Static avd(20), derniermom As Date
    maint = Now
    If maint - derniermom > freq Then
        derniermom = maint
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False
        Set sss = Selection
        elk = Split(cok, ","): elo = Split(cpo, ","): eld = Split(cpd, ",")
        For idc = 0 To UBound(elk)
            If LCase(avd(idc)) <> "ok" And LCase(Range(elk(idc)).Value) = "ok" Then
                Range(eld(idc)).Copy
                Range(elo(idc)).Select
                Range(elo(idc)).Parent.Paste link:=True
            End If
            avd(idc) = Range(elk(idc)).Value
        Next idc
        sss.Select
        Application.Calculation = xlCalculationSemiautomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
 
utile aussi de modifier ceci:
Private Sub Workbook_Open()
Application.EnableEvents = True
Application.Calculation = xlCalculationSemiAutomatic
c = 383
Application.OnTime TimeValue("09:50:00"), Procedure:="RecupCotation" '"09:01:00"
End Sub

et de fermer puis de rouvrir le fichier.

chrisnapoli · Answer

ok pigé 
celui ci marche maintenant parfaitement mis a part que je ne sais pas ou mettre lea procedure des ok qui effacent les cotations qui n ont pas encore leur cours d'ouverture 
c'est la question que je te posais l autre jour  et je voudrais savoir pourquoi ce fichier st si lourd sinon je la i essaye avec les mêmes liens dde sur les 4 feuilles et ca colle parfaitement tout en même temps dit moi stp comment je fait pour inclure la procédure que tu a vais faits toi même?? pour le reste je pense que l on va y arriver aussi petit a petit

chrisnapoli · Answer

re comment sais tu qu il ya 9928 colonnes et  5903 lignes-dans( TIMER SEUL) puisque des colonnes et lignes ont été supprimes
 c'est seulement dans le fichier complet ou il y a tout, sur (CAC 40) que ce nombre est présent  le FIchier TIMER SEUL est le même mais dégraissé en conséquence je ne comprends pourquoi si les feuilles lignes et colonnes supprimes ne sont plus présentes dans ce fichier elles sont comptabilisées
il ya actuellement sur chaque feuille de TIMER SEUL seulement 907 colonnes sur 131 lignes à chaque feuille et il y a 4 feuilles si ces colonnes et lignes ont été supprimes  comment se fait il qu il soit si lourd 
est ce parce que c'est une copie de CAC dégraissé????  c'est quand même étonnant parce que lorsque j ai fait les copies j ai enlevé les feuilles qui ne me servaient pas et les codes aussi il faut déjà résoudre cet énigme et après on verra pourquoi y a conflit  entre les fichier et les graphes 
en ce moment tourne le gros fichier CAC 40 ou il y a tout réuni statistiques graphes en temps réel et Timer)
 il marche depuis 10 h ce matin et a part un peu de retard du timer sur l heure il n y a rien a signaler

chrisnapoli · Answer

Bonjour 
ce nouveau fichier sera indépendant de l autre( le timer 4 feuilles) tournera toujours sur un autre ordinateur 
 les données que je vais coller ne sont pas les mêmes par ailleurs...

 pour le moment j ai fait un serveur localhost] qui me recupere les données sur mon fichier Excel (alimente par les DDE) et qui fait tourner mes graphes sur le web en langage javascript
j attend de voir si c'est efficace et après je prendrais ma décision  j aurais bien aimer faire tourner ça dans excel pour voir ce que cela donnait
  en fait je pense pas qu il soit tres difficile de faire un autre timer en segonde et mettre les destinations dans le sens des lignes 
je n ai aucunement l intention de toucher celui de 4 feuilles dabord parcequ il me sert pour tout autre chose qui est complètement indépendant de cette  nouvelle solution et puis aussi parce que ça marche trop bien 
je m en sert tous les jours il n ya pas une seconde de retard en fin de journée sur les 4 feuilles
 Bonne soirée je vous dirais plus tard

chrisnapoli · Answer

Bonjour  
pourquoi penses tu que le timer va prendre du retard??(au premier fichier il y avait du retard parce qu il y avait un problème sur mon fichier 
désormais il n y a pas une seconde de retard sur la journée  (maintenant il est vrai que ça ne colle que chaque minute)

Ce Timer aurait 120 valeurs a copier dans le sens des lignes sur grosso modo 30600 lignes ce qui ferait 3 672 000 chiffres

chrisnapoli · Answer

Bonjour 
je me sert du timer 4 feuilles depuis pas mal de temps tout fonctionne parfaitement 

 mais petit probleme j ai le timer qui travaille d'un cote seul et quand j ouvre l'autre fichier ou il y a le graphe qui tourne en temps reel ca me provoque des perturbations sur le fichier graphe ,de temps en temps j ai une colonne  de liens DDE qui disparaît 
je ne sais pas pourquoi le timer et le fichier du graphe sont en conflit des que j arrete le graphe alors mon timer colle a nouveau parfaitement

chrisnapoli · Answer

bonsoir 
alors une colonne dans le fichier du timer dans lequel  il n enregistre pas les cotations et une colonne ou disparaissent les liens dde sur l'autre fichier ou tourne le graphe au même instant
il est impossible de faire tourner correctement ls 2 fichiers en même temps

chrisnapoli · Answer

bonjour 

sur l autre fichier c'est juste le graphe avec les barres qui progressent en temps reel avec le même type de DDE

Afficher des plages de cotations sous conditions

41 réponses

Balises code

Où les trouver?

Comment les utiliser?

A noter

Discussions similaires

Newsletters