Afficher des plages de cotations sous conditions - VB / VBA

Afficher des plages de cotations sous conditions Afficher une plage de donnée avec plusieurs conditions » Forum - Bureautique Affiché des cellules en cligneton selon condition (Résolu) » Forum - Excel Transfert de plusieurs plages de données avec condition (Résolu) » Forum - VB / VBA Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Protection plage de cellules sous condition [Résolu] (Résolu) » Forum - Excel

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.

Forum

Afficher des plages de cotations sous conditions Afficher une plage de donnée avec plusieurs conditions » Forum - Bureautique Affiché des cellules en cligneton selon condition (Résolu) » Forum - Excel Transfert de plusieurs plages de données avec condition (Résolu) » Forum - VB / VBA Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Protection plage de cellules sous condition [Résolu] (Résolu) » Forum - Excel

Web: www.shapebootstrap.net

160 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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.

Merci yg_be 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

CCM a aidé 26613 internautes ce mois-ci

Reply
réponses:
  • auteur

    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 

  • yg_be

    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

  • auteur

    tu veux dire en 65 plutot c'est pour le code timer 4 feuilles????

  • yg_be

    je veux dire ceci: https://cjoint.com/c/HFujz35kbnt

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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.

Reply
réponses:
  • auteur

    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

  • gbinforme

    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)

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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.

  • auteur

    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

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    ya un truc que je pige pas
    Peut-être postuler chez Microsoft pour faire qu'excel fonctionne selon tes désirs ;-)

  • yg_be

    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
    .

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

ç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

Reply
réponses:
  • gbinforme

    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 

  • yg_be

    bonjour, je suggère de remplacer

    Range(elo(idc)).Copy Destination:=Range(eld(idc))

    par
    Call linkrg ( Range(eld(idc)) , Range(elo(idc)) )

  • gbinforme

    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://msdn.microsoft.com/fr-fr/VBA/excel-vba/articles/range-copy-method-excel?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.query%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk%28vbaxl10.chm144104%29%3Bk%28TargetFrameworkMoniker-Office.Version%3Dv15%29%26rd%3Dtrue

  • yg_be

    je pense que, contrairement à ce qu'il écrit, chrisnapoli souhaite créer des liens, pas copier. d'où ma suggestion.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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é

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • auteur

  • yg_be

    "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.

  • auteur

    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

  • yg_be

    le code proposé par gbinforme doit être dans une feuille.

  • auteur

    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

  • yg_be

    as-tu utilisé linkrg?

  • gbinforme

    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.

  • auteur

    je n ai fait que faire ce que tu m 'as dit j ai mis le code dans la feuille et dans la feuille il y a déjà cette procédure
    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

    c'est sans doute pour cette raison que ton collègue ma dit de mettre ma macro dans un module a part
    pour ton code jai essaye dans ma feuille comme tu m as dits mais également dans le module si la procédure qui est déjà dans la feuille gène ton code il suffit de me dire ou je peux le déplacer
    je ne peux pas deviner je t'ai deja dit que je n avais pas la compétence ,je suis oblige de m 'en tenir a ce que vous me dites
    j ai egalement essayer de changer la ligne comme me l a demande YGB mais sans résultat je vais supprimer la procedure de la feuille remettre ton code et dits moi ou je peux mettre cette procedure dont j ai besoinegalement
    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

  • yg_be

    la prochaine fois que tu montres du code, peux-tu utiliser la coloration syntaxique?

  • auteur

    ok
    alors dits moi si j'enleve ce code de ma feuille puisque semble til cela gene son code ou dois je le mettre alors ????
    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

  • yg_be

    merci d'utiliser la coloration syntaxique quand tu montres du code. c'est gentil d'écrire "ok", ce serait mieux de le faire. maintenant.

  • auteur

    mais comment faits tu ??

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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é.

Reply
réponses:
  • yg_be

    merci de passer le temps nécessaire pour maîtriser cela et mieux communiquer.

  • Whismeril

    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é.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

le probleme il est pas dans la couleur du code

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • yg_be

    avec un peu de temps et de volonté, tu vas y arriver. merci de persévérer.

  • gbinforme

    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.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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 

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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... ;-)

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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 

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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 

  • yg_be

    bonjour, pourquoi cela ne fonctionne pas ?

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • gbinforme

    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 

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed