Grafige 2. dikey eksen ve Tablo basligi ekleme

[zuzzu]

Arkadaslar merhaba,

Kitaptan örnek kodlar ile kendime göre bir grafik cizme kodu toparladim ancak 2. dikey eksene, kopyalanan sütunlardan birini aktaramiyorum.

Sicaklik kolonunun sag taraftaki 2. dikey eksende gözükmesini istiyorum.
Basinc ve strain degerleri 1. dikey eksende gösterilecek.
Yatay eksende de zaman var.


Bir de ChartTitle kodunda bir hata veriyor, anlamadim nesi yanlis. Bir türlü basligi yazdiramadim.

Baslik icin de B1 hücresindeki Strain yazisinin sadece RAI kismini (yani belirli harf araligini) yazdirmak istiyorum. Yalniz basligin alinacagi hücrenin adresi degisebilir.
Bu örnekte B1 hücresinde yer aliyor ama ileride B39dan da bu harfleri sectirebilirim.

Yardimlariniz icin cok tesekkür ederim

Kolay gelsin.

 

[Ferhat Pazarçevirdi]

Merhabalar,

Kodunuzu şu şekilde revize ediniz. Eklediğim kısımları kırmızı ile gösterdim.

Sub CreateChart()

'Create an embedded chart

Dim co As ChartObject
Dim cw As Long, rh As Long

'get data for positioning
cw = Columns(1).Width
rh = Rows(1).Height

'position chart using column width and row heights units
Set co = ActiveSheet.ChartObjects.Add(cw * 9, rh * 8, cw * 8, rh * 19)

'name it
co.Name = "ChartExample"

'set chart type
co.Chart.ChartType = xlXYScatterSmoothNoMarkers

'add axes

With co.Chart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlCategory, xlSecondary) = False
.HasAxis(xlValue, xlPrimary) = True
.HasAxis(xlValue, xlSecondary) = True
End With

'add data series
co.Chart.SeriesCollection.Add _
Source:=ActiveSheet.Range("A1:D31"), _
rowcol:=xlColumns, serieslabels:=True, _
Categorylabels:=True

'axis title formatting

co.Chart.Axes(xlCategory).HasTitle = True
co.Chart.Axes(xlCategory).AxisTitle.Caption = "Zaman (s)"
co.Chart.Axes(xlCategory).AxisTitle.Border.Weight = xlMedium



With co.Chart.Axes(xlValue, xlPrimary)
    .HasTitle = True

    With .AxisTitle
        .Caption = "Basinc (bar), Strain (µm/m)"
        .Font.Size = 10
        .Orientation = xlHorizontal
        .Characters(14, 4).Font.Bold = True
        .Border.Weight = xlMedium
    End With

End With

[COLOR="Red"]'---------------------------------------
co.Chart.SeriesCollection(3).AxisGroup = 2
'---------------------------------------[/COLOR]

With co.Chart.Axes(xlValue, xlSecondary)
    .HasTitle = True

    With .AxisTitle
        .Caption = "Sicaklik (K)"
        .Font.Size = 10
        .Orientation = xlHorizontal
'        .Characters(14, 4).Font.Bold = True
        .Border.Weight = xlMedium
    End With

End With
'set the crossing point to 0
co.Chart.Axes(xlValue).CrossesAt = 0

'gridlines
co.Chart.Axes(xlValue).HasMajorGridlines = False
co.Chart.Axes(xlCategory).HasMajorGridlines = False

'tickmarks on category axis
'co.Chart.Axes(xlCategory).MajorTickMark = xlTickMarkCross


co.Chart.Axes(xlCategory, xlPrimary).HasMajorGridlines = True
With co.Chart.Axes(xlCategory, xlPrimary).MajorGridlines.Border
        .Color = RGB(0, 0, 255) '255=white
        '.LineStyle = xlDot
        '.Weight = xlThin
End With

'LegendKey
With co.Chart.Legend.LegendEntries(1).LegendKey
        .Interior.ColorIndex = 15
        .Border.Weight = xlThick
End With

'position legend
co.Chart.Legend.Position = xlLegendPositionBottom

'move tick labels to below chart area
co.Chart.Axes(xlCategory).TickLabelPosition = _
xlTickLabelPositionNextToAxis

'set chart area to solid white
co.Chart.ChartArea.Interior.Color = RGB(255, 255, 255)

With co.Chart.ChartArea.Fill
.Visible = True
'.ForeColor.SchemeColor = 255
'.BackColor.SchemeColor = 255
'.TwoColorGradient Style:=msoGradientHorizontal, variant:=1

End With

'set plot area fill to white
co.Chart.PlotArea.Interior.ColorIndex = 15

'format chart title
[COLOR="red"]'-------------------------------
    Dim oTitle As ChartTitle
    co.Chart.HasTitle = True
    Set oTitle = co.Chart.ChartTitle
    With oTitle
        .Caption = "Rai"
        .Font.Size = 14
        .Font.Bold = True
        .Border.Weight = xlThick
        .Position = xlChartElementPositionAutomatic
    End With
    co.Activate
'---------------------------------[/COLOR]
ActiveChart.PrintPreview

End Sub

.

 

[zuzzu]

Ferhat Bey,

Cok tesekkür ederim kodlar ise yaradi, calisiyor Dün bütün gün kitaplari karistirdim, internetten baktim. Nafile....

Ferhat Bey, arkadaslar, bir seri sorularim daha olacak, kisaca aciklayabilirseniz cok sevinirim.


+ co.Chart.SeriesCollection(3).AxisGroup = 2 satirinda anlatmak istediginiz nedir?

+ Kodlama sirasinda secilecek hücreleri A1: D31 arasinda sectim ama sütun sayisi dinamik oldugu icin, sütunlar nereye kadar devam ediyorsa, oraya kadar olan araligi belirle ve sec kodunu nasil yazdirabilirim?

+ A sütununun her zaman "Zaman" olarak algilanmasi ve her zaman yatay eksende gösterilmesi icin hangi kodlar gereklidir?

+ Excelde son sütunda bulunan degerlerin(D sütunu da olabilir AA sütunu da olabilir) her zaman 2. dikey eksende gösterilmesi icin hangi kodlar gereklidir?

+ Bir de Plot Area yani tablo icindeki grafigin boyutunu, tablo penceresine otomatik olarak uyarlama, fit etmek nasil yapiliyor? Yoksa bu otomatik olarak algilanip yapiliyor mu?

Vaktiniz olursa sorularima kisa da olsa aciklama yapabilirseniz cok memnun olurum. Programin daha 5%'ini bile beceremedim, kaldi ki bu en basit adimi, grafik cizdirme.

Gercekten yardimlariniza cok ihtiyacim var, vaktiniz olursa sorularimi yanitlayabilirseniz cok minnettar olurum.

Iyi calismalar.

 

[zuzzu]

Arkadaslar,

Bu VBA konusu benim yüksek lisans tezim ve aslinda egitimini aldigim bir konu degil.
Programlamada daha cok yeniyim ve asiri yavas ilerliyorum.

Cevaplayabileceginiz sorularim varsa, yanitlarsaniz cok memnun olurum.
Takildim ilerleyemiyorum ve sadece 3 ayim kaldi.

Cok cok tesekkür ederim.

 

[Ferhat Pazarçevirdi]

+ co.Chart.SeriesCollection(3).AxisGroup = 2 satirinda anlatmak istediginiz nedir?

Bunun anlamı; "Grafikteki, '3 Nolu' seriyi, 'İkincil Eksen'de göster" demek.

+ Kodlama sirasinda secilecek hücreleri A1: D31 arasinda sectim ama sütun sayisi dinamik oldugu icin, sütunlar nereye kadar devam ediyorsa, oraya kadar olan araligi belirle ve sec kodunu nasil yazdirabilirim?

Bunun için; grafiğe, "Source" göstermektense, Serileri tek tek ilave etmek daha mantıklıdır. Aşağıda örnek kodlarda bunu açıkladım.

           [COLOR="Green"] 'Grafiğe seriler ilave ediliyor[/COLOR]
            For i = 2 To lSonSutun
                With .SeriesCollection.NewSeries
                    .XValues = ActiveSheet.Range(Cells(2, 1), Cells(lSonSatir, 1))
                    .Values = Range(Cells(2, i), Cells(lSonSatir, i))
                    .Name = Cells(1, i)
                End With
            Next i

+ A sütununun her zaman "Zaman" olarak algilanmasi ve her zaman yatay eksende gösterilmesi icin hangi kodlar gereklidir?

Bunun için; serilerin "XValue" değerlerini daima "Zamanı" ifade eden değerleri atamalısınız. Aşağıdaki örnek kodlarda bunu açıkladım.

                   .XValues = ActiveSheet.Range(Cells(2, 1), Cells(lSonSatir, 1))

+ Excelde son sütunda bulunan degerlerin(D sütunu da olabilir AA sütunu da olabilir) her zaman 2. dikey eksende gösterilmesi icin hangi kodlar gereklidir?

Bunun için; son sütunun hangisi olduğunu bulup, o sütunun grafikteki seri nosununun AxisGroup'unu 2'ye eşitlemelisiniz. Aşağıdaki kodlarda bunu açıkladım.

           [COLOR="green"] 'Son sütunda bulunan veriler (son seri), ikincil eksene aktarılıyor[/COLOR]
            .SeriesCollection(lSonSutun - 1).AxisGroup = 2

+ Bir de Plot Area yani tablo icindeki grafigin boyutunu, tablo penceresine otomatik olarak uyarlama, fit etmek nasil yapiliyor? Yoksa bu otomatik olarak algilanip yapiliyor mu?

"Plot Area"; "Grafik Başlığı", "Eksen Başlıkları" ve "Gösterge metni" ilave edildikten sonra kalan alana otomatik olarak yerleştirilir. Ama siz buranın boyutuyla da oynayabilirsiniz. Sizin ilk kod örneğinizde yaptığınız hata, "Eksen başlıkları"nın yönlendirilmesini (oriantation) ve "Gösterge Metni"nin konumunu (posisiton) kodlarla iyi ayarlayamamış olmanızdır. Aşağıdaki örnekte bunu açıkladım.

Şimdi, Çalışma Kitabınızdaki son kodları silerek aşağıdakileri yerleştirin ve kullanın.

Option Explicit

Sub Grafik_Yarat()
    Dim co As ChartObject
    Dim lSonSutun As Long
    Dim lSonSatir As Long
    Dim i As Integer
    
[COLOR="green"]    'Varsa önceki grafiğin silinmesi[/COLOR]
    On Error Resume Next
    Set co = ActiveSheet.ChartObjects("Benim_Kodladigim_Grafik")
    co.Delete
    On Error GoTo 0
    
[COLOR="green"]    'Yeni bir grafik omurgası yarat
    'Grafik konumu ve büyüklüğünü ayarlamak için referans alınan hücre H2'dir.
    'Siz değiştirebilirsiniz.[/COLOR]
    With Range("H2")
        Set co = ActiveSheet.ChartObjects.Add(Left:=.Left, _
                                             Width:=.Width * 10, _
                                               Top:=.Top, _
                                            Height:=.Height * 18)
    End With
    
[COLOR="green"]    'Grafiği çizilecek alanın son satır ve sütun numaraları[/COLOR]
    lSonSutun = Cells(1, 255).End(xlToLeft).Column
    lSonSatir = Cells(65536, 1).End(xlUp).Row
    
    With co
[COLOR="green"]        'Grafiğe spesifik bir ad veriliyor[/COLOR]
        .Name = "Benim_Kodladigim_Grafik"
        With .Chart
            'Grafiğin tipi belirleniyor
            .ChartType = xlXYScatterSmoothNoMarkers
            
[COLOR="green"]            'Grafiğe seriler ilave ediliyor[/COLOR]
            For i = 2 To lSonSutun
                With .SeriesCollection.NewSeries
                    .XValues = ActiveSheet.Range(Cells(2, 1), Cells(lSonSatir, 1))
                    .Values = Range(Cells(2, i), Cells(lSonSatir, i))
                    .Name = Cells(1, i)
                End With
            Next i
        
[COLOR="green"]            'Son sütunda bulunan veriler (son seri), ikincil eksene aktarılıyor[/COLOR]
            .SeriesCollection(lSonSutun - 1).AxisGroup = 2
            
            [COLOR="green"]'Grafik Başlığı İlave ediliyor[/COLOR]
            .HasTitle = True
            With .ChartTitle
                .Text = "RAİ"
                With .Font
                    .Size = 14: .Bold = True
                End With
            End With
            
            [COLOR="green"]'Birincil Kategori Ekseni (Yatay-x1) için ayarlamalar[/COLOR]
            With .Axes(xlCategory, xlPrimary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = Cells(1, 1)
                    .Orientation = xlHorizontal
                    '.Font.Bold = False
                End With
            End With
            
            [COLOR="green"]'Birincil Değer ekseni (Dikey/y1) için ayarlamalar[/COLOR]
            With .Axes(xlValue, xlPrimary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = "Basinc (bar), Strain (µm/m)"
                    .Orientation = xlUpward
                    '.Font.Bold = False
                End With
            End With
            
            [COLOR="green"]'İkincil Değer ekseni (Dikey/y2) için ayarlamalar[/COLOR]
            With .Axes(xlValue, xlSecondary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = Cells(1, lSonSutun)
                    .Orientation = xlUpward
                    '.Font.Bold = False
                End With
            End With
            
            [COLOR="green"]'Grafik göstergesi alt tarafa alınıyor[/COLOR]
            .Legend.Position = xlLegendPositionBottom
        
        End With
                
    End With
    
    Set co = Nothing

End Sub

 

[zuzzu]

Ferhat Bey,

Size ne kadar tesekkür etsem azdir. Kodlardan zar zor anlasam da, oturup bütün kodu tekrardan yazdiginizi gördüm. Gercekten cok emek etmissiniz, size minnettarim.

Biliyorum sizi cok yordum ancak kodun asagidaki satirinda hata veriyor:

'Son sütunda bulunan veriler (son seri), ikincil eksene aktariliyor
.SeriesCollection(lSonSutun - 1).AxisGroup = 2

Bir de örnek excel dosyasini orijinalinde olacak sekilde tekrardan düzenledim ve hücre, range ayarlarini tekrardan yaptim. Cok kez kontrol ettim, ben bir hata bulamadim. Bu düzeltmeleri de yaparken hücre secme konusunun da mantigini anlamis oldum.

Bir de ek olarak Legend'a, 9. satirdaki basliklari atadim ve yanlarina parantez icinde 10. satirdaki birimlerini yazdirdim. Ancak eksen atama hatasindan dolayi yaptigim eklemeler dogru oldu mu göremiyorum.

Vaktiniz olursa tekrardan bakabilirseniz cok cok tesekkür ederim.

Degistirdigim noktalari kirmizi ile belirttim.




Option Explicit

Sub Grafik_Yarat()
Dim co As ChartObject
Dim lSonSutun As Long
Dim lSonSatir As Long
Dim i As Integer

'Varsa önceki grafigin silinmesi
On Error Resume Next
Set co = ActiveSheet.ChartObjects("Benim_Kodladigim_Grafik")
co.Delete
On Error GoTo 0

'Yeni bir grafik omurgasi yarat
'Grafik konumu ve büyüklügünü ayarlamak için referans alinan hücre H2'dir.
'Siz degistirebilirsiniz.
With Range("H2")
Set co = ActiveSheet.ChartObjects.Add(Left:=.Left, _
Width:=.Width * 10, _
Top:=.Top, _
Height:=.Height * 18)
End With

'Grafigi çizilecek alanin son satir ve sütun numaralari
lSonSutun = Cells(1, 255).End(xlToLeft).Column
lSonSatir = Cells(65536, 1).End(xlUp).Row

With co
'Grafige spesifik bir ad veriliyor
.Name = "Benim_Kodladigim_Grafik"
With .Chart
'Grafigin tipi belirleniyor
.ChartType = xlXYScatterSmoothNoMarkers

'Grafige seriler ilave ediliyor
For i = 2 To lSonSutun
With .SeriesCollection.NewSeries
.XValues = ActiveSheet.Range(Cells(39, 1), Cells(lSonSatir, 1))
.Values = Range(Cells(39, i), Cells(lSonSatir, i))

' Asagidaki kod ile 10. satirda yazan birim aciklamalarini Legend basliginin yanina parantez icinde yazdirdim.
.Name = Cells(9, i).Value & "(" & Cells(10, i) & ")"
End With
Next i

'Son sütunda bulunan veriler (son seri), ikincil eksene aktariliyor - HATA
.SeriesCollection(lSonSutun - 1).AxisGroup = 2
'Grafik Basligi ilave ediliyor
.HasTitle = True
With .ChartTitle

' C9 hücresindeki basligin 4. karakterinden baslayarak sonraki 10 karakterini basliga yazdirma ???
'Dogru mu yaptim bilmiyorum.
.Caption = Trim(Mid(Cells(9, 3), 4, 10))
With .Font
.Size = 14: .Bold = True
End With
End With

'Birincil Kategori Ekseni (Yatay-x1) için ayarlamalar
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
With .AxisTitle

' Asagidaki kod ile x1 yatay ekseninin adinin yanina birimini yazdirdim.
.Caption = Cells(9, 1).Value & "(" & Cells(10, 1) & ")"
.Orientation = xlHorizontal
'.Font.Bold = False
End With
End With

'Birincil Deger ekseni (Dikey/y1) için ayarlamalar
With .Axes(xlValue, xlPrimary)
.HasTitle = True
With .AxisTitle
.Caption = "Basinc (bar), Strain (µm/m)"
.Orientation = xlUpward
'.Font.Bold = False
End With
End With

'ikincil Deger ekseni (Dikey/y2) için ayarlamalar
With .Axes(xlValue, xlSecondary)
.HasTitle = True
With .AxisTitle
.Caption = Cells(9, lSonSutun)
.Orientation = xlUpward
'.Font.Bold = False
End With
End With

'Grafik göstergesi alt tarafa aliniyor
.Legend.Position = xlLegendPositionBottom

End With

End With

Set co = Nothing

End Sub

 

[Ferhat Pazarçevirdi]

Biliyorum sizi cok yordum ancak kodun asagidaki satirinda hata veriyor:

'Son sütunda bulunan veriler (son seri), ikincil eksene aktariliyor
.SeriesCollection(lSonSutun - 1).AxisGroup = 2

Bu satırın hata vermesi normal. Çünkü siz ortam şartlarını değiştirmişsiniz.

Önceden ilk (birinci) satırdan başlayarak aşağıya inen verileriniz, şimdi 9.Satırdan başlayarak aşağıya iniyor.

Bu kodlamada önemli olan nokta; grafik veri tablonuzun başlangıç koordinatının değişmemesi. Başlangıç koordinat derken, tablonun sol-en üst hücresini kastediyorum.

Yani siz ilk gönderdiğiniz örnekte, veri tablonuz "A1" -cells(1,1)- hücresinden başlarken, şimdiki örneğinizde, "A9" hücresinden başlıyor.

Başlangıç koordinatına karar verin ve sabitleyin.

Ben artık başlangıç koordinatının "A9" olduğunu düşünerek kodunuzu yeniledim.

Bir de ek olarak Legend'a, 9. satirdaki basliklari atadim ve yanlarina parantez icinde 10. satirdaki birimlerini yazdirdim. Ancak eksen atama hatasindan dolayi yaptigim eklemeler dogru oldu mu göremiyorum.

Bunu, aşağıdaki kodu çalıştırdığınızda göreceksiniz.

Option Explicit

Sub Grafik_Yarat()
    Dim co As ChartObject
    Dim lSonSutun As Long
    Dim lSonSatir As Long
    Dim i As Integer
    
    On Error Resume Next
    Set co = ActiveSheet.ChartObjects("Benim_Kodladigim_Grafik")
    co.Delete
    On Error GoTo 0
    
    With Range("H2")
        Set co = ActiveSheet.ChartObjects.Add(Left:=.Left, _
                                             Width:=.Width * 10, _
                                               Top:=.Top, _
                                            Height:=.Height * 18)
    End With
    
    lSonSutun = Cells(9, 255).End(xlToLeft).Column
    lSonSatir = Cells(65536, 1).End(xlUp).Row
    
    With co
        .Name = "Benim_Kodladigim_Grafik"
        With .Chart
            .ChartType = xlXYScatterSmoothNoMarkers
            For i = 2 To lSonSutun
                With .SeriesCollection.NewSeries
                    .XValues = ActiveSheet.Range(Cells(39, 1), Cells(lSonSatir, 1))
                    .Values = Range(Cells(39, i), Cells(lSonSatir, i))
                    .Name = Cells(9, i).Value & "(" & Cells(10, i) & ")"
                End With
            Next i
            .SeriesCollection(lSonSutun - 1).AxisGroup = 2
            
            .HasTitle = True
            With .ChartTitle
                .Text = Trim(Mid(Cells(9, 3), 4, 10))
                With .Font
                    .Size = 14: .Bold = True
                End With
            End With
            
            With .Axes(xlCategory, xlPrimary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = Cells(9, 1).Value & "(" & Cells(10, 1) & ")"
                    .Orientation = xlHorizontal
                End With
            End With
            
            With .Axes(xlValue, xlPrimary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = "Basinc (bar), Strain (µm/m)"
                    .Orientation = xlUpward
                End With
            End With
            
            With .Axes(xlValue, xlSecondary)
                .HasTitle = True
                With .AxisTitle
                    .Caption = Cells(9, lSonSutun)
                    .Orientation = xlUpward
                End With
            End With
            
            .Legend.Position = xlLegendPositionBottom
        
        End With
                
    End With
    
    Set co = Nothing

End Sub

 

[zuzzu]

Ferhat Bey,

Güncellenen kodlari koydum ve her sey düzgün olarak calisiyor! Inanamiyorum! :mutlu:
Aciklamanizla, hatali kodun mantigini da anladim.
Emekleriniz icin cok tesekkür ederim, sizden cok sey ögrendim. En azindan artik kendi kendime grafik cizebilirim.

Umarim arkadaslar da örnek kodlardan yararlanabilirler.

Cok cok cok tesekkür ederim.
Iyi calismalar dilerim.