Sujet Précédent Sujet Suivant

Afficher des plages de cotations sous conditions

Fermé
chrisnapoli - Modifié le 18 juin 2018 à 08:52
Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 - 17 juil. 2018 à 08:56
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



EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

41 réponses

Réponse 1 / 41
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 23 juin 2018 à 15:22
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.
1
chrisnapoli
23 juin 2018 à 15:48
ok je veux bien tester mais il faut que tun m'expliques tu dits que l procedure s'execute qu une fois (daccord )
mais alors c'est quoi qui la réactive???
(une fois que un ok change à nouveau de position )
et pourquoi as tu marque 09:50;00(au lieu de 09:01:00 dans le code du bas puisque cette procédure est sur un autre fichier le timer n 'est pas sur ce fichier il est indépendant sur le fichier Timer CAC 40 seul avec ce code vous n avez cesse de me répéter que mes fichiers étaient trop lourd donc je fait tourner le timer seul sur un fichier (puisque il me sert pour l analyse statistique seulement et la partie graphique tourne sur un autre fichier c'est pour cela aussi que j ai essaye également de faire le timer 4 feuilles d'un cote et les fichiers pour chaque marche a part j essaye d'Etre le plus efficace possible 


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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
23 juin 2018 à 19:58
je suis parti de la procédure Workbook_Open() dans le fichier que tu as partagé en #65.
la procédure worksheet_Calculate ne s'exécute plus à cause d'une erreur que j'ai faite dans la procédure worksheet_Calculate proposée en #108. je ne fais plus cette erreur dans le worksheet_Calculate() code proposé en #119, et je répare les dégâts en ajoutant deux lignes dans la procédure workbook_open: 
Application.EnableEvents = True
Application.Calculation = xlCalculationSemiAutomatic
0
chrisnapoli
23 juin 2018 à 20:13
tu veux dire en 65 plutot c'est pour le code timer 4 feuilles????
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > chrisnapoli
23 juin 2018 à 20:16
je veux dire ceci: https://cjoint.com/c/HFujz35kbnt
0
Réponse 2 / 41
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
13 juin 2018 à 09:03
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.
0
Chrisnapoli
13 juin 2018 à 09:20
Bonjour
et merci de t être intéressé a mon soucis

Avant tout je dois te dire que je ne suis absolument pas programmeur
les "OK" changent d'eux même suivant les critères que j ai mis par formule dans les cellules
donc je ne vois pas très bien ou je peux mettre ce que tu m 'écrits et de quelle manière..???? peux tu être plus précis par rapporta mon code
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
13 juin 2018 à 09:43
Re
Si tes changements se font en fonction de formules, il faut utiliser ceci : 
Private Sub Worksheet_Calculate()
    Call RecopiePlage
End Sub

Tu copies ce codes dans ta feuille concernée (mode d'emploi)
0
Réponse 3 / 41
Chrisnapoli
Modifié le 18 juin 2018 à 08:52
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
13 juin 2018 à 10:30
Mais non tu laisses ta procédure "RecopiePlage" telle qu'elle est probablement dans un module et tu mets seulement celle que j'ai mis dans ta feuille.
0
Chrisnapoli
13 juin 2018 à 10:53
ta solution ne va pas parceque ca copie en boucle
sans arret et ca perturbe le graphe ce que je veux c'est que la copie se fasse seulement quand une des cellules contenant les ok change soinon c'est injouable
0
Réponse 4 / 41
Chrisnapoli
13 juin 2018 à 11:02
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
0
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 à 18:02
https://forums.commentcamarche.net/forum/affich-35395315-sub-recopieplage#52
0

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

Posez votre question
Réponse 5 / 41
chrisnapoli
Modifié le 18 juin 2018 à 08:53
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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
14 juin 2018 à 10:14
commençons par améliorer pour ne recopier que quand utile. que donne la suggestion en https://forums.commentcamarche.net/forum/affich-35395315-sub-recopieplage#52 ?
0
chrisnapoli
14 juin 2018 à 10:39
cela ne donne rien du tout
il n y a rien qui se passe
0
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 à 17:16
donc ce que tu mets en #9 fonctionne bien, mais si tu modifies légèrement comment proposé en https://forums.commentcamarche.net/forum/affich-35395315-sub-recopieplage#52 , cela ne fonctionne plus?
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
14 juin 2018 à 17:21
la prochaine fois que tu montres du code, peux-tu utiliser la coloration syntaxique?
0
Réponse 6 / 41
chrisnapoli
14 juin 2018 à 11:06
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
14 juin 2018 à 11:53
ya un truc que je pige pas
Peut-être postuler chez Microsoft pour faire qu'excel fonctionne selon tes désirs ;-)
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
14 juin 2018 à 17:29
c'est simple à comprendre (et je t'ai dèjà expliqué ici).
il ne suffit pas d'écrire du code, il faut qu'Excel le démarre.
il y a plusieurs façons de faire démarrer un code:
- par timer
- par un bouton ou une combinaison de touches
- quand le contenu d'une cellule change (les changements de résultats des formules ne comptent pas)
- quand une feuille est recalculée, ce qui inclut les changements de résultat d'une formule
.
0
Réponse 7 / 41
chrisnapoli
14 juin 2018 à 12:04
ç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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
14 juin 2018 à 20:20
Bonsoir,

ça c'est la réponse de quelqu'un qui ne connait pas la solution et qui ne la trouvera jamais

Je te remercie de ton analyse et je vais essayer de la déjouer. Copie cette procédure très simplifiée par rapport à ton code initial dans ta feuille concernée et tu nous fait une nouvelle analyse. ;-) 
Option Explicit
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)
    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(elo(idc)).Copy Destination:=Range(eld(idc))
        End If
        avd(idc) = Range(elk(idc)).Value
    Next idc
End Sub
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
Modifié le 15 juin 2018 à 08:34
bonjour, je suggère de remplacer 
Range(elo(idc)).Copy Destination:=Range(eld(idc))

par 
Call linkrg ( Range(eld(idc)) , Range(elo(idc)) )
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié le 15 juin 2018 à 09:02
Bonjour yg_be,
Je connais bien ta suggestion "implicite" sauf qu'elle ne fonctionne pas dans certaines configurations par défaut d'excel et donc lorsque l'on ne sait pas celle concernée, je m'abstiens du code par défaut.
Tu peux d'ailleurs vérifier l'exemple de l'aide Microsoft qui utilise ma syntaxe :
https://docs.microsoft.com/fr-FR/office/vba/api/Excel.Range.Copy
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
Modifié le 15 juin 2018 à 09:39
je pense que, contrairement à ce qu'il écrit, chrisnapoli souhaite créer des liens, pas copier. d'où ma suggestion.
0
Réponse 8 / 41
chrisnapoli
14 juin 2018 à 22:31
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é
0
Réponse 9 / 41
Chrisnapoli
15 juin 2018 à 14:56
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
0
Réponse 10 / 41
Chrisnapoli
15 juin 2018 à 15:04
re je viens d'essayer a nouveau mais malgre ce nouveau code il n y rien qui fonctionne
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
15 juin 2018 à 15:21
"rien qui fonctionne", c'est un peu opaque.
retourne dans la situation que tu avais le 13 juin 2018 à 17:19.
ca marchait mais le problème est que ca tournait en boucle: cela devrait aller mieux avec le nouveau code.
0
Chrisnapoli
15 juin 2018 à 15:44
je viens de remettre le code comme tu me l avais fai t et ca marche parfaitement avec le bouton mais si j ajoute dans la feuille
Private Sub Worksheet_Calculate() ca se met à tourner en boucle
Call RecopiePlage

quand au code que m a écrit gbinforme je suis désole mais il n y a rien qui fonctionne même en le modifiant avec la ligne que tu m 'as propose ce code est dans un module
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > Chrisnapoli
15 juin 2018 à 16:21
le code proposé par gbinforme doit être dans une feuille.
0
Chrisnapoli
15 juin 2018 à 16:56
si je le mets dans la feuille alors au lieu de m afficcher les cotations en % cela m 'affiche 0.000% sur toute la feuille
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
15 juin 2018 à 18:26
Bonsoir,

cela m 'affiche 0.000% sur toute la feuille
Le code ne fait que de la copie de plage mais en mettant du code n'importe où, l'on ne peux pas savoir ce que tu nous as fait ?
Le code fonctionne et ne fait que la copie des plages afférentes à la cellule qui passe à "Ok" mais comme il faut deviner la structure de ta feuille qui a sans doute en plus d'autres procédures que je ne connais pas, tu as sans doute créé avec des procédures événementielles ou autres, des cas particuliers en changeant les plages concernées par exemple.
0
Réponse 11 / 41
Chrisnapoli
15 juin 2018 à 21:46
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é.
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
15 juin 2018 à 21:49
merci de passer le temps nécessaire pour maîtriser cela et mieux communiquer.
0
Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
7 juil. 2018 à 21:56
Bonjour
j'ai parcouru ce fil parce que je me suis dit que 144 messages sur le même sujet, ça doit être une sacrée énigme!
Je ne suis pas expert (loin de là en VBA), mais sait on jamais.
Il s'avère que je n'ai pas le niveau en VBA pour t'aider.

Cependant, je sui tombé sur ta remarque sur le "tuto" pour les balises de coloration.
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é.


Etant l'un des rédacteurs de ce tuto, j'aimerai que tu m'aides à l'améliorer.
Premier point, tu sites la fin du paragraphe, le début t'a-t-il paru clair?
Pour rappel

Balises code

Dans un forum à destination des développeurs, il est très courant de devoir poster un bout de code afin d'illustrer clairement son problème. J'insiste bien sur le bout de code car poster un fichier entier ne rime à rien et décourage ceux qui éventuellement pourraient avoir la solution au problème.

Où les trouver?

C'est la 4e icone au-dessus de la zone de texte:

Comment les utiliser?

C'est assez simple finalement. Il vous suffit de coller votre code bien indenté, de le sélectionner et de cliquer sur les chevrons à côté de l'icone. Ici, le choix du langage vous sera proposé



Et que peut-on rendre plus clair ici?

A noter

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é.
0
Whismeril Messages postés 19028 Date d'inscription mardi 11 mars 2003 Statut Non membre Dernière intervention 24 avril 2024 931
17 juil. 2018 à 08:56
Bonjour
Pourrais tu donner ton avis ici
https://codes-sources.commentcamarche.net/forum/affich-10086941-amelioration-procedure-balises-de-code?xxP06ylsnXcOoYZyrQg7dEyJ_eOQjNhu9HSPpyQwIVk

Merci
0
Réponse 12 / 41
Chrisnapoli
15 juin 2018 à 21:48
le probleme il est pas dans la couleur du code
0
Réponse 13 / 41
Chrisnapoli
15 juin 2018 à 22:04
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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
15 juin 2018 à 22:21
avec un peu de temps et de volonté, tu vas y arriver. merci de persévérer.
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
15 juin 2018 à 22:35
Bonsoir,

Si tu n'as que les 6 lignes de codes listées cela ne peut en aucune manière influer sur le code des copies qui ne fait pas de sélection. Par contre je ne sais pas (et je n'ai pas à le savoir) ce que fait ton classeur mais il y a bien une action qui vient modifier les "ok" et cette action si elle résulte d'une procédure peut éventuellement avoir une influence.
0
Réponse 14 / 41
Chrisnapoli
15 juin 2018 à 22:54
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié le 16 juin 2018 à 08:43
Dans BZ 144 la formule est la suivante =SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
Par exemple, dans ce cas, comment est modifié BY144 ?

J'ai modifié le code pour éviter toutes les actions autres pendant son déroulement, essaies cette version : 
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
End Sub
0
Réponse 15 / 41
Chrisnapoli
16 juin 2018 à 08:54
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
0
Réponse 16 / 41
Chrisnapoli
16 juin 2018 à 09:13
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
0
Réponse 17 / 41
Chrisnapoli
16 juin 2018 à 10:06
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
16 juin 2018 à 11:21
apparemment c'est extrêmement complexe
Dis toujours je ne sais pas si l'on peux te donner 3 solutions mais impossible n'est pas français depuis plus de 2 siècles, alors... ;-)
0
Réponse 18 / 41
chrisnapoli
Modifié le 18 juin 2018 à 08:59
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié le 18 juin 2018 à 08:40
Bonjour,

voila mon second soucis ... d'ou vient l 'erreur dans le code??
Dans le code que tu as mis, il y a de nombreuses erreurs :
- tu as des variables en double
- des variables non initialisées
- dans module6 j ai Private Sub Workbook_BeforeClose(Cancel As Boolean) mais cela ne peut fonctionner que dans thisworkbook
- la procédure 'copy_dh' est en double donc tu peux supprimer ton module 6
- la procédure 'RecupCotation1' n'est pas utilisée

Dans ton second classeur, si tu veux gérer 4 feuilles il faudrait sans doute préciser la feuille concernée.

Sans savoir ce que tu veux précisément cela me semble pas très net comme code.
Si tu as vu ma phrase de St-Ex tu comprendras qu'avant de mettre d'autre code, je commencerai, à ta place d'enlever ce qui est inutile ou en double.
Cela pourrait donner dans thisworkbook : 
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)
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
et dans module1 : 
Option Explicit
Public Durée As Date
Public c As Long
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
0
Réponse 19 / 41
chrisnapoli
18 juin 2018 à 11:19
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
18 juin 2018 à 12:03
Bonjour,

pour ce qui est du module 8 est ce que l ecriture est correcte
Tu as bien dû te rendre compte que cela ne fonctionne pas ?
Si tu pouvais utiliser la bannière code c'est étudié pour être lisible comme ceci : 
Option Explicit
Dim marches() As String
Sub init_marches()
ReDim marches(3)
    marches(0) = "CAC40"
    marches(1) = "AEX"
    marches(2) = "BEL20"
    marches(3) = "PSI20"
End Sub
Sub copy_dh1()
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
Sub copy_dh()
Dim marche As Variant
Dim fl As Worksheet
    For Each marche In marches
        Set fl = Sheets(marche)
        Call copy_dhfl(fl)
    Next marche
End Sub
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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
18 juin 2018 à 18:53
bonjour, pourquoi cela ne fonctionne pas ?
0
Réponse 20 / 41
chrisnapoli
18 juin 2018 à 16:04
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
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
18 juin 2018 à 18:29
Bonsoir,

Toujours pas d'utilisation de la bannière code : si tu tiens vraiment à l'aide du forum le minimum c'est d'en respecter les règles et cela ne te demande qu'un clic. 
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)
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
0

Discussions similaires

Retrouver l'image originale après avoir fait des modifications ?
Raven -
bonjou -

9 réponses
programme qui n'affiche pas le mot secret
EMy.chev -
yg_be -

3 réponses
Afficher toutes les lignes masquées excel
livlarsen -
esicom -

26 réponses
Mise en forme conditionnelle 2 conditions
happydays -
Emilie -

7 réponses