Données et graph en temps reel

Version imprimable

Voir 40 message(s) de cette discussion en une page

Oui, mais le MsgBox ne fait pas de différence entre Texte et nombre, or, s'il y à un point c'est du texte, pour le modifier en VBA c'est pas évident

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PremCol As Integer, NoLig As Long, NoGraph As Integer
Dim Derlig As Long, PremLig As Integer
Dim FL1 As Worksheet
 
Dim e As Integer
Dim D As Double
Dim Txt As String
 
    If Target.Address <> "$A$1" Then
        Exit Sub
    Else
        Set FL1 = Worksheets("Feuil1")
        Derlig = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
        Txt = Cells(1, 1)
        e = InStr(1, Txt, ".")
        If e > 0 Then
            Mid(Txt, e, 1) = ","
            D = Format(Txt, "###.#############")
            Cells(Derlig + 1, 1) .Value = D
        End If
 
    End If
    PremCol = 1 'Première colonne de la source de données du graphe
    DerCol = 1  'Dernière colonne de la source de données
 
    PremLig = 2 'Première ligne de la source de données
    'dernière ligne renseignée de la source de données (ici de la feuille de calculs)
    Derlig = FL1.Cells(Columns(PremCol).Cells.Count, PremCol).End(xlUp).Row
    'Adresse de la nouvelle plage après insertion d'une ligne ou la modif d'une cellule
    Plage = Range(Cells(PremLig, PremCol), Cells(Derlig, DerCol)).Address
    NoGraph = ActiveSheet.ChartObjects.Count
    ActiveSheet.ChartObjects(NoGraph).Activate
    ActiveChart.SetSourceData Source:=Sheets("Feuil1").Range(Plage), PlotBy _
        :=xlColumns
 
End Sub

Modifie comme celà, met dans A1 un nombre identique à tes données genre "2.56666"
et tu dit..

17/12/2007, 10h37
bergoliv

J ai cette ligne qui apparait en rouge dans le code, c est normal ou est ce une erreur?

Cells(Derlig + 1, 1) .Value = D
17/12/2007, 10h44
LeForestier

je recharge le fichier pour tester, et je revient
17/12/2007, 10h54
LeForestier

probable une erreur au copier/coller, il y a un espace entre
1) ICI .Value = D
Tu le supprime
17/12/2007, 11h05
bergoliv

ok, la conversion fonctionne quand je rentre un chiffre en manuel, je fait un test avec le lien DDE

Toujours pas de liste qui se crée malgrés la resolution du probleme de la virgule. Ca me parait logique puisque il y a toujours le probleme que A1 est une formule et ne change jamais donc pas de detection d excel. non?

Hummm. pour éviter les erreurs en cas de nombre entier il faudrait encore modifier...

Code:

1
2
3
4
5
        If e > 0 Then
            Mid(Txt, e, 1) = ","
            D = Format(Txt, "###.#############")
            Cells(Derlig + 1, 1).Value = D
        End If

par

Code:

1
2
3
4
5
6
7
        If e > 0 Then
            Mid(Txt, e, 1) = ","
            D = Format(Txt, "###.#############")
            Cells(Derlig + 1, 1).Value = D
        else
            Cells(Derlig + 1, 1).Value = val(Txt)
        End If

Je reviens là-dessus :

Citation:

ce qui me donne un chiffre a virgule du style 2.0025

Ce que je ferais, si A1 change, j'y placerais la valeur lue convertie
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) If Target.address = "$A$1" then Target = Val(replace(Target, ".",",")) 'ou sinon Target = Format(replace(Target, ".",","),"0.0000") endif 'la suite du code
Tu peux toujours tester...

Edit
Ok, ça remplace la formule :( Faut pas ! Alors à la place de "Target = ....", mets l'adresse de la 1ère cellule vide de la colonne A. (tu as le code)

Code:

Cells(DerLig, 1).value = Format(replace(Target, ".",","),"0.0000")

17/12/2007, 12h41
bergoliv

merci,
mais je crois qu on s egare avec l histoire de la virgule ou du point.

j ai trouvé un lien qui parle exactement du probleme ( enfin d apres ce que je comprends moi)
17/12/2007, 12h50
LeForestier

Citation:

Envoyé par bergoliv

Toujours pas de liste qui se crée malgrés la resolution du probleme de la virgule. Ca me parait logique puisque il y a toujours le probleme que A1 est une formule et ne change jamais donc pas de detection d excel. non?

J'ai testé et c'est juste, l'événement change n'est pas appelé :?
Autre problème qu'il va falloir résoudre

Edit:
J'avais pas vu ton poste, mais le problème virgule était bien réel.
17/12/2007, 12h57
LeForestier
Je n'ai pas testé avec une connection DDE mais avec une autre feuille et tu pourrais essayé en mettant le code dans
Code:

1 2 3 Private Sub Worksheet_Calculate() End Sub
Avec mon essai j'ai un résultat.. Sans garantie mais un essai ne coute rien..
Edit:
Bonjour Ousk,
J'avais cherché une solution dans tout les sens mais pas pensé au Replace :king:

Voila j ai repris et ca fonctionne, dans la message box le prix s affiche bien donc on doit pouvoir faire la liste ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Worksheet_Calculate() If Range("A1").Value = valcel Then Else mymacro End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then mymacro Else valcel = Range("A1").Value End If End Sub Sub mymacro() MsgBox (Range("A1").Value) End Sub
Ha, a la place de la message box j ai fait afficher la valeur dans B1, ca fonctionne il n y a plus qu a ajouter le code qui fait le decalage de cellule.

En plus , et ca c est rigolo!!, la nouvelle valeur en B1 s affiche avec une VIRGULE !!!!!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub Worksheet_Calculate() If Range("A1").Value = valcel Then Else mymacro End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then mymacro Else valcel = Range("A1").Value End If End Sub Sub mymacro() Range("B1") = Range("A1").Value 'MsgBox (Range("A1").Value) End Sub

17/12/2007, 13h31
LeForestier

Citation:

En plus , et ca c est rigolo!!, la nouvelle valeur en B1 s affiche avec une VIRGULE !!!!!

T'a fini de te moquer de nous.... :evilred: :P:P :king:
17/12/2007, 13h47
bergoliv

Non, non je me moque pas , juste que ca fait tout seul un truc qu on n'attendait pas.

Mais bon si vous avez besoin de professeur en programmation vba je suis votre homme :mrgreen:

Ha non ca peut pas etre possible, puisque j enseigne que a partir d'un certain niveau :wow:

arf arf c etait facile, vous m en voulez pas?:oops:

En attendant je patoge ....

BBBBBEEEEEEEEAAAAAAAARRRRRRRRRRRRRRGGGGGGGGGGG!!!!!!!!!!!!!!!!!!!!!!

ca marche, la liste ce crée toute seule ligne apres ligne, il me manque plus qu a inserer le graphique :lahola:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Worksheet_Calculate()
If Range("A1").Value = valcel Then Else mymacro
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
mymacro
Else
valcel = Range("A1").Value
End If
End Sub
 
 
Public Sub mymacro()
 
'Range("B1") = Range("A1").Value
 
Dim Derlig As Long
    Derlig = Sheets("Feuil2").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    If Range("A1").Value = Range("A1").Value Then
 
        Cells(Derlig + 1, 1) = Range("A1").Value
 
    End If
 
'MsgBox (Derlig.Value)
End Sub

Je n arrive pas a finir, l insertion du code de la parti graph me pose probleme.

17/12/2007, 17h22
LeForestier
Tu te complique la vie là...:mouarf:
remet TOUT comme c'était quand ça fonctionnait, avec détection des virgules etc...
et dans Calculate tu met
Code:

1 2 3 4 5 Private Sub Worksheet_Calculate() if ActiveCell.Address = "$A$1" then Worksheet_Change ActiveCell end if End Sub
Edit:
Je vais refaire un classeur et te le repasser, mais ce serra pas avant 20hr je suis occupé pour le moment
17/12/2007, 17h39
ouskel'n'or

Citation:

Envoyé par bergoliv

Je n arrive pas a finir, l insertion du code de la parti graph me pose probleme.

Remontre-nous tout ton code qu'on fasse le ménage. Enfin, je laisserai LeForestier le soin de le faire, vu qu'il s'est dévoué :mouarf:
Quant à

Citation:

Envoyé par bergoliv

Mais bon si vous avez besoin de professeur en programmation vba je suis votre homme

Ha non ca peut pas etre possible, puisque j enseigne que a partir d'un certain niveau :wow:

tu fais bien de nous le dire, je ne répondrai plus jamais à tes questions, et d'ailleurs, je vais carrément proposer qu'on t'interdise de forum VBA-Excel :langue:

Citation:

arf arf c'était facile, tu ne m'en veux pas ? :oops:

Maintenant que je suis vengé, j'attendrai avec toi le code de l'homme des bois ;)
17/12/2007, 18h40
bergoliv

1 pièce(s) jointe(s)

ouskel'n'or tu veus te donner des airs de gros mechant parceque au fond de toi tu as le coeur sur la mains arf arf Ca prend pas 2eme fois!!

bien essayé:D

Au fait, tu sais pourquoi je ne veus pas croire que tu es comme tu veus le faire paraitre?

Voila ce que j ai fait , c est pas exactement la meme structure mais bon, je fais ce que je peus.

Le seul probleme qu il me reste c est que je n arrive pas a faire la plage variable des données. A par ca c est fonctionnel.

ouskel'n'or, tu pourras te moquer comme ca , de ce que j ai fait.:mouarf3:

:calin:

Pièce jointe 23046

signé le :boulet:

Hello,
Déjà, là je ne comprends pas ce que tu fais ici
Code:

1 2 If Range("A1").Value = Range("A1").Value And Range("A2").Value > 0 Then _ Cells(Derlig + 1, 1) = (Range("A1").Value - Range("A2").Value) * 10000
Si tu peux m'expliquer ça alors je suis sûr de comprendre le reste :mouarf:
A+

17/12/2007, 19h11
LeForestier

1 pièce(s) jointe(s)

OK, l'homme des bois a eu fini un peu plus tôt que prévu, :mrgreen:
Pas Faaaaacile du touuuuut, vu qu'ont est obligé d'employé l'événement calculate ca repasse un grand nombre de fois.
Bof.. J'ai résolu les problèmes et heureusement que je l'ai fait de chez moi parce par poste c'était certainement pas possible bien qu'en final c'est tout simple, mais j'au du faire BEAUCOUP de déboguage.
Je l'ai fait avec mes mérthodes, que n'en déplaise....;)
Tu lit bien les explications que j'ai mis dans le haut du module 1 avant de faire quoi que ce soit.
Ah, autre remarque, probablement un bug de VBA, bien que la plage renseignée est bien "A2:A.. La fin de colonne"
Le graph ne commence qu'à A3 ?
Allez, bon amusement
17/12/2007, 19h18
bergoliv

Citation:

tu fais bien de nous le dire, je ne répondrai plus jamais à tes questions

Deja ,tu me reparles!! héhéhéhé. c est moi qui t es eu :mouarf:

Je sais pas si je vais t expliquer finalement,.... je reflechi,...., peut etre,...bon allé apres mure reflection, et vu que j aime bien aider les débutants:mouarf3: je vais te repondre.

Cette astuce me permet de metre a une méme échelle de valeur toutes les paires de monnaie existante afin de les metres sur un seul graph.

C est la base de la construction de mes activitées boursieres.

Voir 40 message(s) de cette discussion en une page