ChartSpace ve Listbox nesnesi

[hsayar]

Yukarıdaki resimde görüleceği üzere ChartSpace nesnesinin custom tuşu ile ulaşılan Veri sayfasına makro ile veri girmek nasıl olmalıdır?

Amacım Listbox1 nesnesinin 1, 3 ve 4 nolu kolonlarındaki verileri; chartspace nesnesinin 1(katagori adı) 2(Seri 1 değeri) ,3 (seri2 değeri) nolu sütunlarına getirmek. yardımlarınız için teşekkür ederim.

saygılarımla.

bağlantı çok sık kesiliyor resmi evden yollayacağım.

 

[Levent Menteşoğlu]

Kullandığınız chartspace hangi versiyondur. Bu nesneyle ilgili olarak aşağıdaki linki incelemenizi öneririm.

Userformda grafik

 

[hsayar]

levent hocam sürüm bendede aynı 12.0.0.6211, yalnız bende sizdeki gibi menü çubukları çıkmıyor.

 

[hsayar]

bir fransız sitesinden aşağıdaki kodları buldum adam Değer ve başlıkları diziye almış öyle oluşturuyor. Ancak ben grafik tipini istediğim şekil olan çubuğa (chChartTypeLine) çekince hata gönderiyor...

Private Sub UserForm_Activate()
Dim oChart   As ChChart ', oConst As Constants
Dim oSeries1 As ChSeries
Dim oSeries2 As ChSeries
Dim oAxis1   As ChAxis
Dim oAxis2   As ChAxis

Dim S1(43), S2(43), S3(43) As Variant

'on crée les tableaux de variables
For i = 1 To 43
S1(i) = Cells(i + 1, 2)
S2(i) = Cells(i + 1, 3)
S3(i) = Cells(i + 1, 4)
Next


With ChartSpace1
'on efface tout
  .Clear
  ' Création diagramme dans le ChartSpace
  Set oChart = .Charts.Add
  ' Ajout 1ere série de type XYscatter plot
End With

Set oSeries1 = oChart.SeriesCollection.Add
With oSeries1
  .Caption = "Current"
  .Type = chChartTypeScatterSmoothLine  ' on peut changer le type, se reférer à l'explorateur d'objet
  '.Type = chChartTypeLine
  .SetData chDimXValues, chDataLiteral, S1()
  .SetData chDimYValues, chDataLiteral, S2()
End With
' Ajout 2eme série de type XYscatter plot

Set oSeries2 = oChart.SeriesCollection.Add
With oSeries2
  .Caption = "estimate"
  .Type = chChartTypeScatterSmoothLine
  .SetData chDimXValues, chDataLiteral, S1()
  .SetData chDimYValues, chDataLiteral, S3()
End With

' les Axes
Set oAxis1 = oChart.Axes(chAxisPositionLeft)
With oAxis1
  .Scaling.Maximum = 0.05
  .Scaling.Minimum = 0.025
  .NumberFormat = "0.0%"
  .HasMajorGridlines = True
End With

Set oAxis2 = oChart.Axes(chAxisPositionBottom)
With oAxis2
  .Scaling.Maximum = 30
  .Scaling.Minimum = 0
  .NumberFormat = "0"
  .HasMajorGridlines = True
End With

'on indiue la légende
With oChart
  .HasLegend = True
  .Legend.Position = chLegendPositionBottom
'on définit la couleur de fonds
  .PlotArea.Interior.Color = "white"
End With

'on peut définir toutes les propriétés supplémentaires en se référant à l'explorateur sous "spacechart"
End Sub

örnek dosyayı eklemeye çalışacağım.(önce orj. kodları bulayım)

örnek dosya aşağıdaki linktedir. bağlantı hatası oluştu
http://www.excel.web.tr/attachment.php?attachmentid=52555&stc=1&d=1227255964

 

[hsayar]

Nihai olarak yapmak istediğim ise ilk mesajımda bahsettiğim alttaki dosyada,
Listbox1in doldurulması esnasında CharSpace2 nesnesinindeki grafiğin değişmesi.

listbox1 aşağıdaki kodlar ile dolmakta:

Aşağıdaki kırmızı satırlarrın herhengi bir yeri tercih edilerek doldurulabilir. Yanlış hatırlamıyorsma chartspace sql veriyide kabul ediyor, o şekilde olur, ama bu durumda benim bilmediğim recordset filter özelliğini kullanmak gerekecek.

Sub adbKset_Tarihler_Aç()
  Set CSfData = CKtp_Bu.Sheets("DATA")     'Verilerin alınacağı sayfa.
  Dim sqlFrom$, sqlBasl$, sqlSorg$, sqlSatr$, sqlGrup$

  sqlBasl = "Tarihi, Aktif_Değeri, Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlGrup = "Sayac_No, Adi_Soyadi, Mevkii, Tarihi, Aktif_Değeri, Reaktif_Değeri, Kapasitif_Değeri, Aciklama"
  sqlFrom = "[" & CSfData.Name & "$" & "A2:H1800" & "]"
  sqlSorg = "Sayac_No = " & Me.ComboBox1.Column(0)                                       'Sayaç Numarası, Combobox1'e eşit olan kayıtlar
  sqlSorg = sqlSorg & " AND UCase(Adi_Soyadi) Like '" & UCase(Me.TextBox1.Text) & "'"    ' ve Adı soyadı,  textbox1'i içeren kayıtlar
  sqlSorg = sqlSorg & " AND Tarihi IS NOT NULL"
  sqlSatr = "SELECT DISTINCT " & sqlBasl & " FROM " & sqlFrom & " WHERE " & sqlSorg
  'sqlSatr = sqlSatr & " GROUP BY  " & sqlGrup
  sqlSatr = sqlSatr & " GROUP BY  " & sqlGrup & " ORDER BY Tarihi DESC"
'ORDER BY UnitPrice DESC
'  : sqlSatr : "SELECT DISTINCT Tarihi, Aktif_Değeri, Reaktif_Değeri, Kapasitif_Değeri, Aciklama FROM [DATA$A2:H1800] WHERE Sayac_No = 1582 AND UCase(Adi_Soyadi) Like 'AHMET ER' AND Tarihi IS NOT NUL"
  'Adob RecordSet Sorgulaması
  If Err = 0 Then
    Set adbKset = CreateObject("ADODB.Recordset")
    With adbKset
      .ActiveConnection = adbBagl
      .CursorLocation = adUseServer
      .CursorType = adOpenKeyset
      .LockType = adLockOptimistic
      .Source = sqlSatr
      .Open
      '***********************************************************************
      ListBox1.Clear
      Label15.Caption = Space(5) & .RecordCount & " Adet Okuma Kaydı bulundu"
      If .RecordCount > 0 Then
        With ListBox1
'                Stop

          .ColumnCount = adbKset.Fields.Count
          .ColumnWidths = "60;60;60;60;100"
          .Column = adbKset.GetRows
          .TextAlign = fmTextAlignRight
'        Stop
' [COLOR=Red]       Set ChartSpace2.DataSource = [/COLOR]

        End With 'ListBox1
      End If
    If CBool(.State And adStateOpen) = True Then .Close:  Set adbKset = Nothing
    End With
  Else
    MsgBox "Bağlantı Hatası Kontrol Ediniz", vbInformation, "Bilgi"
  End If
  With ListBox1
    If .ListCount > 0 Then
      For i = 0 To .ListCount - 1
        If .List(i, 0) <> "" Then .List(i, 0) = Format(.List(i, 0), "dd.mm.yyyy")
        If .List(i, 1) <> "" Then .List(i, 1) = Format(.List(i, 1), "#,##0.0000")
        If .List(i, 2) <> "" Then .List(i, 2) = Format(.List(i, 2), "#,##0.0000")
        If .List(i, 3) <> "" Then .List(i, 3) = Format(.List(i, 3), "#,##0.0000")
      Next i
    End If
  End With

[COLOR=Red]'??????????????????[/COLOR]





End Sub

 

[hsayar]

MEvcut listboxdan verileri alarak chartspace nesnesinde 1. mesajdaki tipte görülen grafik oluşturlamaz mı?