Graphique dynamique avec scrollbar
Bonjour,
Je suis débutant en vba. Merci d'avance pour vos lumières et votre tolérance pour des questions qui pourront paraître stupides...
Je travaille sur un code capable de tracer un graph Absorbance = f (Température) à partir de data récupérées à partir d'un appareil qui mesure l'absorbance (nombreux points) à différentes températures. J'ai donc un fichier avec les longueurs d'onde en 1ère colonne et les valeurs d'absorbance dans les colonnes suivantes. A noter que le nombre de longueurs d'onde et de températures est variable. La subtilité est que je désire tracer le graphe à une longueur d'onde désirée que je peux modifier avec un scrollbar entre les valeurs 210 et 335nm (qui permet ainsi de modifier la valeur de mes ordonnées). En gros j'ai la possibilité de naviguer sur 130 longueurs d'onde différentes.
Je suis partiellement arrivé à mes fins. J'obtiens le graphe désiré à la longueur d'onde définie par le scrollbar (295nm: valeur définie par défaut). Malheureusement, mon scrollbar n'est pas dynamique dans le sens ou rien ne se passe lorsque je change sa valeur.
Mon hypothèse est que ce problème provient du fait que mes ordonnées sont définies par un range (=Ordonnees) dans mon code mais qui une fois la macro terminée perd le lien avec la valeur de mon scrollbar qui est lu en F4:
Dim Ordonnee As Range
'la valeur du scrollbar sera affichée dans la cellule F4 et servira de valeur de recherche dans la première colonne du range CircularDichroism'
lambda = Range("F4").Value
Range("CircularDichroism").Select
Selection.Columns(1).Cells.Select
Set Ordonnee = Selection.Find(what:=lambda, LookAt:=xlPart)
'si la valeur n'est pas trouvée'
If Ordonnee Is Nothing Then
MsgBox ("Changer la longueur d'onde avec le chariot svp")
'si valeur trouvée'
Else:
Ordonnee.Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Set Ordonnee = Selection
En effet, lorsque je sélectionne les datas du graph a posteriori, la plage correspondant aux ordonnées = à une plage classique d'excel qui n'a aucune raison d'être mise à jour d'une manière ou d'une autre. Je pensais ainsi utiliser une plage nommée avec le code
Names.Add Name:="ordonnees", RefersTo:=OrdonneeMalheureusement, je n'arrive pas à définir la plage nommée dans mon code vba. J'ai essayé:
Dim CDfT As ChartObject
Set CDfT = ActiveSheet.ChartObjects.Add(60, 50, 500, 300)
With CDfT.Chart
.ChartType = xlXYScatterSmoothNoMarkers
.SeriesCollection.NewSeries
.SetSourceData Source:=Ordonnee
With .SeriesCollection(1)
.Values = Range("ordonnees")J'ai tenté également .Values= ("ordonnees") ou (="ordonnees") ou (ordonnees) ou (=ordonnees) sans succès. Je ne sais pas du coup si cela permettra d'obtenir un graphe dynamique...
Deuxième possibilité: j'ai tenté de faire un rafraichissement du graphe avec une macro que j'ai liée à mon scrollbar:
Sub Scrollbar_control()
lambda = Range("F4").Value
Range("CircularDichroism").Select
Selection.Columns(1).Cells.Select
Set Ordonnee = Selection.Find(what:=lambda, LookAt:=xlPart)
'si la valeur n'est pas trouvée'
If Ordonnee Is Nothing Then
MsgBox ("Changer la longueur d'onde avec le chariot svp")
'si valeur trouvée'
Else:
Ordonnee.Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Set Ordonnee = Selection
ActiveSheet.ChartObjects.Refresh
End If
End SubCela me permet de sélectionner la nouvelle plage pour mes ordonnées (qui est recherchée par la valeur en F4 dans le range CircularDichroism) mais je n'ai jamais réussi à ce que ça rafraichisse mon graphe. Au mieux rien ne se passe, au pire ça bugue. Auriez vous une piste?
J'ai réussi à obtenir ce que je désire avec un OFFSET mais cela me demande d'écrire de nouvelles lignes dans mon fichier (ce que je préfèrerais éviter) et en plus cela demande un calcul tordu afin de lier la valeur de mon scrollbar qui n'a rien à voir (en F4) au numéro de la ligne où sont les valeurs recherchées.
Existe t'il une autre solution plus simple à laquelle je n'aurais pas pensé?
Merci encore une fois pour vos suggestions et d'avoir tout lu!
Bonne journée
est-ce que vous pouvez ajouter votre fichier, cela travaille plus facile.
Bonjour,
Merci pour la réponse et désolé pour ma réponse tardive, j'étais éloigné de mon PC ce week end. Je joins le fichier excel en question. Il y a 3 modules: le 1 me permet de trier les data brutes. Le module 2 sert à faire le graphique et le 3 à contrôler le scrollbar. Merci d'avance pour votre aide et bonne journée
si je comprend bien, tu veux un longueur d'onde que tu choisis, créer le graph et puis sauvegarder ce graph ?
Sub teste()
With Sheets("750Na Tm R")
If WorksheetFunction.Median(210, 350, .Range("F4").Value) = .Range("F4").Value Then 'valeur est bon
.Range("G21").Value = Int(.Range("F4").Value)
.Range("D5:J19").CopyPicture xlScreen, xlPicture 'copy plage du graph
Application.Goto Sheets("Feuil1").Range("D10") 'déplacer vers une cellule aleatoire
ActiveSheet.PasteSpecial 'coller l'image du graph
End If
End With
End SubOui c'est cela. Je ne veux toutefois pas enregistrer le graphe , je veux juste qu'il soit dynamique dans le sens où le graphe affichera la courbe à la longueur d'onde qui est sélectionnée par le scrollbar. Si je ne fais pas cela, j'ai potentiellement 130 graphiques affichables (1 / longueur d'onde) donc totalement illisible si je dois tous les afficher.
Merci pour l'aide!
Pour le code, merci pour la piste. Je suis cependant obligé de sélectionner mon range avec des références relatives vu que d'un fichier à l'autre je n'ai pas forcément le même nombre de points et de longueurs d'onde ce qui alourdit notablement mon programme je le concède. Si qqn a des suggestions pour le rendre plus fluide, je suis preneur, même si mon problème est ailleurs et concerne vraiment la façon que le graphe puisse se rafraîchir instantanément quand je sélectionne une autre longueur d'onde avec le scrollbar. La valeur de la longueur d'onde ne correspond donc pas à la moyenne de 210 à 350, je dois pouvoir sélectionner n'importe quelle valeur dans cet intervalle pour m'afficher le graphique correspondant.
si tu choisis un longueur dans F4et pousse le bouton, dans feuil1 le graphique est réalisé.
Merci énormément BsAlv! C'est parfait.
Je vais me plonger dans le code. J'essaierai d'implémenter mon scrollbar pour que le changement de longueur d'onde se fasse de cette manière et ça sera parfait.
Encore merci pour ton aide et bonne journée
avec un scrollbar plus visible et la fonction "camera" qui projecte le graph de la feuille "feuil1" dans la première feuille
C'est plus que parfait maintenant, un énorme merci!
Bonjour BsAlv et aux autres membres de la communauté
Je préfère prolonger cette discussion que créer une nouvelle demande vu que ma question porte sur le déchiffrage du code de BsAlv qui fait des merveilles et j'aimerais bien que le magicien me dévoile un peu ses tours!!!
J'arrive à comprendre en général le code mais mon niveau atteint clairement ses limites pour ce bout de code qui fait réellement des merveilles (et que j'aimerais bcp réutiliser pour d'autres projets), total respect
Set sh = Sheets("750Na Tm R")
longueur = Int(sh.Range("g21").Value)
If WorksheetFunction.Median(210, 350, longueur) <> longueur Then MsgBox "faux choix": Exit Sub
Application.ScreenUpdating = False
arr = Evaluate("transpose(if('750Na Tm R'!A1:A500=" & longueur & ",row('750Na Tm R'!a1:a500),""~""))")
arr1 = Filter(arr, "~", 0, 1)
With Sheets("feuil1")
'Application.Goto .Range("A1")
.Range("A1:A4").EntireColumn.ClearContents
If UBound(arr1) < 0 Then Exit Sub
a = Array(23, 153, 283)
For i = 0 To UBound(a)
.Range("B" & i + 1).Resize(, 50).Value = sh.Range("A" & a(i)).Resize(, 50).Value
Next
For i = 0 To UBound(arr1)
Select Case arr1(i)
Case 24 To 152: .Range("B5").Resize(, 50).Value = sh.Range("A" & arr1(i)).Resize(, 50).Value: .Range("A5").Value = "CD (mdeg)"
Case 154 To 282: .Range("B6").Resize(, 50).Value = sh.Range("A" & arr1(i)).Resize(, 50).Value: .Range("A6").Value = "HT (V)"
Case 284 To 410: .Range("B7").Resize(, 50).Value = sh.Range("A" & arr1(i)).Resize(, 50).Value: .Range("A7").Value = "ABS"
End Select
Next
.ChartObjects(1).Chart.ChartTitle.Text = "longueur onde " & longueur & " nm"
End WithJe comprends bien le Median par contre je ne comprends que très partiellement le "arr" et "arr1" qui sert à la construction de l'array. Que renvoie arr?
Que teste la transposition de "arr" et qu'est ce qui est renvoyé pour arr1? Le if a l'air de tester dans un premier temps si la variable longueur est présente dans la plage A1:A500 (à ce propos pourquoi la variable ne peut elle pas plus simplement être trouvée sous forme integer en mettant = longueur sans les guillemets qui ont l'air de faire référence à un string?) Ensuite je ne comprends pas ce que fait le if avec les 2 autres variables. Est ce que pour row le changement en lowercase de la plage a1:a500 est important, que fait le tilde et pourquoi est il nécessaire de l'avoir entre guillemets?
Enfin que fait le filtre pour arr1 qui récupère le résultat de arr mais ensuite je ne comprends pas.
J'espère ainsi comprendre ensuite comment est renseigné l'array à 3 dimensions (les dimensions sont elles choisies "à la louche"?) dans la suite du code.
Merci d'avance pour vos éclairages et nonne journée à tous!
bonjour,
If WorksheetFunction.Median(210, 350, longueur) <> longueur Then MsgBox "faux choix": Exit Sub
si longueur est inférieur à 210 ou supérieur a 350, c'est un mauvais choix, donc c'est un simple check de le valeur longueur est acceptable.
arr = Evaluate("transpose(if('750Na Tm R'!A1:A500=" & longueur & ",row('750Na Tm R'!a1:a500),""~""))")
Regardez le fichier jointe, dans la colonne A de la feuille "750Na...", les cellules ont toutes sortes de valeur et supposons que nous voulons savoir les lignes des cellules "Calarnao". Dans une feuille auxiliaire, on peut ajouter des formules comme dans la feuille "evaluate" cellules A1:A500. Toutes les cellules "~" n'ont pas d'importance, seulement les cellules numériques le sont. Maintenant, on fera cela en mémoire, la partie rouge, c'est la traduction en anglais de ces formules et puis le "Evaluate" c'est pour donner à VBA le commande de faire le calcul est sauvegarder le résultat dans un array. Donc le résultat sera un 2D-array equivalent a dim Arr(1 to 500, 1 to 1) avec des valeurs "~" et numériques. Ce sont les valeurs numériques que nous voulons savoir, donc il faut filtrer les résultats, et cela n'est possible que dans un 1D-array ! Après une transposition, le résultat est un array equivalent a Dim Arr(1 to 500)
Prochain step
arr1 = Filter(arr, "~", 0, 1)
Filtrer ce 1D-array à 500 éléments pourque juste les valeurs numériques restent = eliminer tous les valeur "~" = ce Fonction Filtre avec 3ième paramètre 0
le résultat est maintenant un 1D-array à base 0 (1ier élément a index 0 !!!) et le nombre, on peut le savoir avec Ubound(arr) (c'est +1 parce qu'on commence avec 0)
prochain step
If UBound(arr1) < 0 Then Exit Sub >>> si l'il n'y a pas de valeurs numériques, le "UBound" de arr1 = -1, donc la macro finit sans résultat.
Normallement il y a 3 résultats possible, un pour chaque courbe, courbe 1 pour le résultat trouvé entre les lignes 24-152, courbe 2 = 154-282 et courbe 3 = 284-410
For i = 0 To UBound(arr1) est donc pour ces 3 courbes, mais comme c'est base 0, ce n'est pas de 1 à 3, mais de 0 à 2.
Compris ? Je dois le faire d'une autre manière ave plus de main-d'œuvre ?
Merci pour la rapidité de ta réponse! Je vais me plonger dans tes explications et ne manquerai pas de revenir en espérant que j'aurai tout compris!
Un très grand merci dans tous les cas pour prendre le temps de nous expliquer
Bonjour BsAlv et les autres membres du forum,
Je fais enfin un retour sur mon dernier post. Ça m'a pris du temps (je n'ai pas eu bcp de temps et je dois dire que je me suis bien pris la tête
Pour vraiment fignoler, je ne comprends pas l'utilité du 1 dans arr1 = Filter(arr, "~", 0, 1) mais c'est vraiment pour chipoter.
J'ai essayé de réutiliser un code similaire pour retrouver des strings mais ça ne marche pas, j'imagine car il est nécessaire d'avoir des nombres pour effectuer des tris? J'y suis arrivé par des boucles mais c'est moins direct que cette solution.
Merci dans tous les cas pour l'aide et à bientôt peut être
bonjour,
c'est bien d'essayer de comprendre tout
ce fonction Filter en VBA, je suis sûr que l'explication existe aussi en français, mais Google refuse de me le donner
Votre code similaire, vous pouvez l'ajouter ici (ou commencer une nouvelle question), alors je peux vous donner l'explication pourque cela n'a pas réussi.
Bonjour BsAlv (et aux autres),
Merci pour l'explication. Je suis en train de finaliser mon code et je bute sur un problème pour le tri des arrays:
Dim arr, arr1 As Variant
arr = Evaluate("transpose(if(A1:A500 =" & lambda & ",row(A1:A500),""~""))")
arr1 = Filter(arr, "~", 0, 1)Cela fonctionne parfaitement comme cela mais comme je suis amené à avoir des tableaux plus courts ou plus longs, j'ai inséré une variable :
last_Row = Cells(Rows.Count, 1).End(xlUp).Row
afin de restreindre la plage de recherche et ainsi améliorer l'efficacité du code. Malheureusement, impossible de changer le A500 par quoi que ce soit
J'ai tenté A1:A & last_Row & et d'autres combinaisons. J'ai tenté de convertir l'integer last_Row en string, rien n'y fait.
Qu'est ce qui est testé dans le if? Le A1:A500 est considéré comme un range, un array? Si array, de string, integer??
Pour le deuxième point concernant la recherche de string utilisant un code similaire, mon pb était peut être lié à ma question précédente. Je n'ai malheureusement pas gardé mon code pour la recherche de string utilisant cette technique vu que j'y suis arrivé d'une autre manière assez simplement, je recherche en fait les occurrences "Channel" dans le fichier d'origine (qui est un .txt), qui apparaissent comme Channel 1, Channel 2 et Channel 3 et qui indiquent le début des tableaux de valeurs qui m'intéressent:
Sub Tri_Raw_Data()
Dim i As Byte
'Calcul de la dernière ligne remplie dans le fichier
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'recherche des lignes contenant "Channel" ie lignes début tableaux de valeurs
Dim FirstFound As Integer
Dim FoundCell As Range
Dim ArrayChannels() As Variant
Dim SearchColumnA As Range
Set SearchColumnA = ActiveSheet.Range("A1:A" & lastRow)
Set FoundCell = SearchColumnA.Find(What:="Channel", After:=Range("A" & lastRow))
ReDim ArrayChannels(0) 'Sizing array to upper bound 0. Array size is 2= size in absence of Abs and HT values
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Row
Else
MsgBox ("Data error detected, no relevant data points detected")
End If
ArrayChannels(0) = FoundCell.Row
i = 1
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
On Error Resume Next
'Find next cell with "Channel" value
Set FoundCell = SearchColumnA.FindNext(After:=FoundCell)
If FoundCell.Row = FirstFound Then Exit Do Else
'Add found cell to Channel range variable
ReDim Preserve ArrayChannels(i)
ArrayChannels(i) = FoundCell.Row
i = i + 1
Loop
i = 0
If UBound(ArrayChannels) = 2 Then
ExpType = Array("CircularDichroism", "HT", "Absorbance")
ElseIf UBound(ArrayChannels) = 1 Then
ExpType = Array("CircularDichroism", "Absorbance")
ElseIf UBound(ArrayChannels) = 0 Then
ExpType = Array("CircularDichroism")
Else: MsgBox ("No CD Data (Channel 1) found in file"): Exit Sub
End If
'chgt text des channels
For i = 0 To UBound(ArrayChannels)
With Range("$A$" & ArrayChannels(i))
.ClearContents
.Offset(1).Range("A1").Select
End With
Selection.Value = ExpType(i)
Next
'nommage range CD, Abs et HT
For i = 0 To UBound(ExpType)
Range("$A$" & ArrayChannels(i) + 4).Select
Selection.CurrentRegion.Select
With Selection.Columns(1).Font
.Bold = True
.Size = 12
End With
Range(ExpType(i)) = Selection
Selection.Name = ExpType(i)
Next3 methodes pour facilement jouer avec la plage
'methode 1
s = "A1:A500" 'l'address de la plage en forme texte
arr = Evaluate("transpose(if('750Na Tm R'!" & s & "=" & longueur & ",row('750Na Tm R'!" & s & "),""~""))") 'intégrer ce texte dans l'évaluate
arr1 = Filter(arr, "~", 0, 1) 'le matrice avec les lignes concernées
'methode2
s = ""
For Each c In Sheets("750Na Tm R").Range("A1:A500").Cells 'ici vous pouvez facilement changer la plage vous-même
If c.Value = longueur Then s = s & "," & c.Row 'les numéros separé avec un virgule
Next
If Len(s) > 0 Then arr1 = Split(Mid(s, 2), ",") 'le matrice avec les lignes concernées
'methode 3
Set dict = CreateObject("scripting.dictionary")
For Each c In Sheets("750Na Tm R").Range("A1:A500").Cells
If c.Value = longueur Then dict.Add c.Row, vbEmpty
Next
If dict.Count Then arr1 = dict.keys 'le matrice avec les lignes concernéeset peut-être l'autre question (approximatif, je ne connais pas vraiment la feuille)
Dim ArrayChannels(1 To 3) 'réserver 3 possibilités
ptr = 0 'pointer
For Each c In Sheets("???").Range("A1:A500").Cells 'ici vous pouvez facilement changer la plage vous-même
If InStr(1, c.Value, "channel", 1) > 0 Then 'la cellule contient "channel" ? (en majuscules ou miniscules)
If ptr = UBound(ArrayChannels) Then MsgBox "dépasse la limite de ArrayChannels": Exit For 'vous avez déjà 3 channels et maintenant un 4ième ???
ptr = ptr + 1 'incrementer pointer
ArrayChannels(ptr) = c.Row
End If
Next
Select Case ptr 'nombre de channels
Case 3: Exptype = Array("CircularDichroism", "HT", "Absorbance")
Case 2: Exptype = Array("CircularDichroism", "Absorbance")
Case 1: Exptype = Array("CircularDichroism")
Case 0: MsgBox ("No CD Data (Channel 1) found in file"): Exit Sub
End Select
For i = 1 To ptr 'autant de channels
With Range("$A$" & ArrayChannels(i))
.ClearContents
.Offset(1).Range("A1").Value = Exptype(i - 1)
With .Offset(4).CurrentRegion.Columns(1).Font
.Bold = True
.Size = 12
End With
End With
NextMerci encore pour cette leçon de vba! Ce n'était donc pas si facile a priori de jouer avec les plages d'adresses. J'ai utilisé la méthode 2 qui fonctionne très bien dans mon cas. Et j'ai également implémenter le dernier code pour trier mes data, idem ça fonctionne très bien. J'en ai fini avec cette partie du projet, un immense merci pour ton aide BsAlv! Je vais m'attaquer à une extension qui ressemble pas mal à ce projet, j'espère que j'y arriverai sans problème.