çubuk grafiğindeki renklendirmeyi çizgi grafiğinde yapmak münkün mü?

blazer2004 · 8 Ekim 2008

arkadaşlar bir sorum olacak ben bir grafik üzerinde alt limitte kırmızı ideal limitte ise yeşil yapma makrosu buldum ben bunu çubuk grafik değilde çizgi grafiğinde uygulayabilmem mümkünmü bana makrosunu yazarmısınız?

blazer2004 · 9 Ekim 2008

arkadaşlar bu konu hakkında bilgisi olan varsa lütfen bana yardımcı olabilir mi.

Ferhat Pazarçevirdi · 10 Ekim 2008

Ekteki örneği inceleyiniz.

blazer2004 · 13 Ekim 2008

çok teşekkürler Ferhat Bey ama bunu makro şeklinde kodlarını biliyorsan çok sevinirim.yinede çok sagol

Ferhat Pazarçevirdi · 15 Ekim 2008

Ekteki örnek dosyayı inceleyiniz.

Bu dosyada hem manuel hem de makro ile çözüm bulunmaktadır. Makro ile otomatik hazırlanan grafik; biraz tembelliğime geldiğinden, şekil-şemal açısından eksiklikleri var ... Siz birkaç satır kod ekleyerek, daha fazla görsellik kazandırabilirsiniz.

Özel grafiği yaratmak için, dosyada kullanılan kodlar aşağıda verilmektedir.

Kod:

Sub Grafik_Olustur()
 
    Dim cht As ChartObject
    Dim rngKaynak As Range
    Dim sAdres_X As String
    Dim sAdres_Y As String
 
    With Sheets("MAKRO")
 
        For Each cht In .ChartObjects
            cht.Delete
        Next
 
        Set rngKaynak = .Range("B7:C" & .Cells(65536, 2).End(xlUp).Row)
 
        With rngKaynak
            sAdres_X = .Offset(1, 0).Resize(.Rows.Count - 1, 1).Address
            sAdres_Y = .Offset(1, 1).Resize(.Rows.Count - 1, 1).Address
        End With
 
        Set cht = .ChartObjects.Add( _
                        Left:=.Range("E8").Left, _
                        Width:=.Range("E1:M1").Width, _
                        Top:=.Range("E8").Top, _
                        Height:=.Range("E8:E31").Height)
 
        ActiveWorkbook.Names.Add _
                Name:="AltLimit", _
                RefersTo:="=ISNUMBER(" & sAdres_X & ")*" & .Range("C3").Address
 
        ActiveWorkbook.Names.Add _
                Name:="AltLimitin_Alti", _
                RefersTo:="=IF(" & sAdres_Y & "<=" & .Range("C3").Address & "," & sAdres_Y & "," & "NA()" & ")"
 
    End With
 
    With cht
 
        With .Chart
 
            .SetSourceData Source:=rngKaynak
            .ChartType = xlLineMarkers
 
            With .SeriesCollection.NewSeries
                .Name = "AltLimit"
                .Values = "='" & ThisWorkbook.Name & "'!" & "AltLimit"
            End With
 
            With .SeriesCollection.NewSeries
                .Name = "AltLimit_Alti"
                .Values = "='" & ThisWorkbook.Name & "'!" & "AltLimitin_Alti"
            End With
 
            On Error Resume Next
 
            .SeriesCollection("AltLimit").MarkerStyle = xlNone
            .SeriesCollection("AltLimit_Alti").Border.LineStyle = xlNone
 
            On Error GoTo 0
 
        End With
 
    End With
 
    Set cht = Nothing
    Set rngKaynak = Nothing
 
End Sub

------ Düzenleme : Dosya eki yenilenmiştir / fpc -----

blazer2004 · 15 Ekim 2008

Sayın Ferhat bey allah razı olsun verdiğiniz bilgi ve makro çok güzel ama ben biraz kendime uyarlamakta karıştırdım acaba dosya göndersem bana yardımcı olurmusunuz.Şimdiden çok teşekkür ederim

Ferhat Pazarçevirdi · 15 Ekim 2008

Ekteki dosyayı inceleyiniz.

Dosyanıza sadece aşağıdaki kod ilave edilmiştir. Bu kodu, standart bir module sayfasına koplayarak, istediğiniz grafik elde edilebilir.

Kod:

Sub Grafik_Olustur()
    
    Dim wks As Worksheet
    Dim cht As ChartObject
    Dim rngKaynak As Range
    Dim sAdres_X As String
    Dim sAdres_Y As String
    Dim nm As Name
    
    Set wks = Sheets("değerler")
    
    For Each cht In wks.ChartObjects
        cht.Delete
    Next
    
    For Each nm In ThisWorkbook.Names
        nm.Delete
    Next
    Set rngKaynak = wks.Range("B5:M5")
    
    With ThisWorkbook
        
        .Names.Add _
            Name:="Veriler", _
            RefersTo:="=IF(" & rngKaynak.Address & "=0,NA()," & rngKaynak.Address & ")"
    
        .Names.Add _
            Name:="Kategoriler", _
            RefersTo:=rngKaynak.Offset(-1, 0)
            
        .Names.Add _
            Name:="AltLimit", _
            RefersTo:="=ISNUMBER(" & rngKaynak.Address & ")*" & wks.Range("P6").Address
        
        .Names.Add _
            Name:="UstLimit", _
            RefersTo:="=ISNUMBER(" & rngKaynak.Address & ")*" & wks.Range("Q6").Address
        
        .Names.Add _
            Name:="AltLimit_Altindakiler", _
            RefersTo:="=IF(" & rngKaynak.Address & "=0,NA()," & "IF(" & rngKaynak.Address & ">" & wks.Range("P6").Address & ",NA()," & rngKaynak.Address & "))"
    
        .Names.Add _
            Name:="UstLimit_Ustundekiler", _
            RefersTo:="=IF(" & rngKaynak.Address & ">" & wks.Range("Q6").Address & "," & rngKaynak.Address & ",NA())"
    
    End With
        
    With wks
        Set cht = .ChartObjects.Add( _
                        Left:=.Range("B9").Left, _
                        Width:=.Range("B9:M9").Width, _
                        Top:=.Range("B9").Top, _
                        Height:=.Range("B9:B27").Height)
    
    End With
    
    On Error Resume Next
    
    With cht
        
        With .Chart
            
            .ChartType = xlLineMarkers
            
            With .SeriesCollection.NewSeries
                .Name = "Veriler_Serisi"
                .Values = "='" & ThisWorkbook.Name & "'!" & "Veriler"
                .XValues = rngKaynak.Offset(-1, 0)
                .Border.ColorIndex = 10
                .MarkerBackgroundColorIndex = 10
                .MarkerForegroundColorIndex = 10
                .MarkerStyle = xlCircle
                .MarkerSize = 8
            End With
           
            
            With .SeriesCollection.NewSeries
                .Name = "AltLimit_Serisi"
                .Values = "='" & ThisWorkbook.Name & "'!" & "AltLimit"
                .MarkerStyle = xlNone
                .Border.ColorIndex = 3
                .Border.Weight = xlThick
            End With
            
            With .SeriesCollection.NewSeries
                .Name = "UstLimit_Serisi"
                .Values = "='" & ThisWorkbook.Name & "'!" & "UstLimit"
                .MarkerStyle = xlNone
                .Border.ColorIndex = 3
                .Border.Weight = xlThick
            End With
            
            With .SeriesCollection.NewSeries
                .Name = "AltLimit_Alti_Serisi"
                .Values = "='" & ThisWorkbook.Name & "'!" & "AltLimit_Altindakiler"
                .Border.ColorIndex = xlNone
                .MarkerBackgroundColorIndex = 3
                .MarkerForegroundColorIndex = 3
                .MarkerStyle = xlCircle
                .MarkerSize = 8
            End With
            
            
            With .SeriesCollection.NewSeries
                .Name = "UstLimit_Ustu_Serisi"
                .Values = "='" & ThisWorkbook.Name & "'!" & "UstLimit_Ustundekiler"
                .Border.ColorIndex = xlNone
                .MarkerBackgroundColorIndex = 3
                .MarkerForegroundColorIndex = 3
                .MarkerStyle = xlCircle
                .MarkerSize = 8
            End With
            
            With .Axes(xlValue)
                .MinimumScale = 150
                .MaximumScale = 300
            End With
            
            .Legend.Delete
        
        End With
    
    End With
    
    Set cht = Nothing
    Set rngKaynak = Nothing
    Set wks = Nothing
    
End Sub

blazer2004 · 15 Ekim 2008

çok teşekkürler ferhat bey ben kendi dosyama uygulamaya çalıştım ama ben aynı grafik üzerine burda 200 değerleri için uygulattık birde 300 için uygulama şansım varmı ben birşeyler yapmaya çalıştım ama bir yerde hata verdi bu dosyaya bakarmısınız.şimdiden teşekkürler

Ferhat Pazarçevirdi · 15 Ekim 2008

Ben son gönderdiğiniz dosyadan, açıkçası hiçbirşey anlamadım.

Siz alta eklediğiniz satır için de (300'ler) yeni bir grafik oluşturulmasını mı bekliyorsunuz? Yoksa, her iki seri aynı grafik üzerinde mi olacak ?

Bir diğer merak ettiğim husus, bunları neden makro ile istediğiniz ? Çünkü, grafikler bir kere oluşturulduğunda artık siz verileri değiştirdikçe/ekledikçe/sildikçe, yeniden yapılandırılacaktır. Yeniden yeniden makroyla çizmeye ne hacet ?

blazer2004 · 16 Ekim 2008

kusura bakmayın ferhat bey ben anlatamadım.Ama problemi çözdüm eksik rakamdan dolayı hatayı vermiş .Sizden ricam alt limit altında serisinde minimum değere eşitse grafikte nokta kırmızı oluyor.bunu minimum değere eşitse yeşil yapabilirmiyim.uğraştım ama çözemedim.birde grafik scalasını 10 luk olarak sabitleme şansım varmı.birde x katagorisi (aylar&#305

hangi satırdan alıyor grafiği başka sheet'de gösterdiğim zaman x katagorisi(aylar) gözükmüyor.bunu öğrenebilirmiyim.Ben bu grafiği kullanıcılar üzerinde değişiklik yapmasın veya silmesin diye makrolu olmasını istedim.Gerçi size çok zahmet verdim.Allah razı olsun benimle ilgilendiniz.teşekkür ederim.

Ferhat Pazarçevirdi · 17 Ekim 2008

Belirttiğim yerleri kodunuzda revize ediniz. Revizyonlar, kırmızı ile gösterilmiştir.

1.Sorunuz :

Sizden ricam alt limit altında serisinde minimum değere eşitse grafikte nokta kırmızı oluyor.bunu minimum değere eşitse yeşil yapabilirmiyim.uğraştım ama çözemedim.

Kod:

.Names.Add _
    Name:="AltLimit_Altindakiler", _
    RefersTo:="=IF(" & rngKaynak.Address & "=0,NA()," & "IF(" & rngKaynak.Address & ">[COLOR=red][B]=[/B][/COLOR]" & wks.Range("P6").Address & ",NA()," & rngKaynak.Address & "))"
.Names.Add _
    Name:="AltLimit_Altindakiler1", _
    RefersTo:="=IF(" & rngKaynak1.Address & "=0,NA()," & "IF(" & rngKaynak1.Address & ">[COLOR=red][B]=[/B][/COLOR]" & wks.Range("P7").Address & ",NA()," & rngKaynak1.Address & "))"

2.Sorunuz

birde grafik scalasını 10 luk olarak sabitleme şansım varmı

Kod:

With .Axes(xlValue)
    .MinimumScale = 150
    .MaximumScale = 360
[COLOR=red][B]    .MajorUnit = 10[/B][/COLOR]
End With

3.Sorunuz

birde x katagorisi (ayları) hangi satırdan alıyor grafiği başka sheet'de gösterdiğim zaman x katagorisi(aylar) gözükmüyor.bunu öğrenebilirmiyim.

X ekseni yani kategori ekseni, aşağıdaki kodla ayarlanıyor. Kodun anlamı ise : rngKaynak adlı aralığın, bir satır yukarıya kaydırılmış hali ... Koddaki yeri de şurası :

Kod:

.Names.Add _
    Name:="Kategoriler", _
    RefersTo:=rngKaynak.Offset(-1, 0)
.Names.Add _
    Name:="Kategoriler1", _
    RefersTo:=rngKaynak1.Offset(-1, 0)

Ama sizin probleminiz bu değil. Siz, wks adlı sheet objeyi, istediğiniz sayfaya set etmelisiniz. Yani;

Kod:

Set wks = Sheets("değerler")

satırı değişmeli. Bunu bir parametre olarak prosedüre ilave edebilirsiniz. Daha sonra sırasıyla, sayfalara göre grafik çizdirebilirsiniz.

4.Sorunuz

Ben bu grafiği kullanıcılar üzerinde değişiklik yapmasın veya silmesin diye makrolu olmasını istedim.

Grafikleri bir kere çizdikten sonra sayfayı korumaya alsanız daha iyi olmazmıydı

blazer2004 · 17 Ekim 2008

çok teşekkür ederim ferhat bey aslında çok basitmiş ama mantığını çözemedim belki ondan karıştırdım.sizden son bir ricam grafiğin arka planındaki gri rengi nasıl beyaz yapabilirim.size çok zahmet verdim allah razı olsun benimle ilgilendiniz.

parametre · 6 Mart 2009

grafige geliniz mouseyi cizgilerin arasına getirip sag tus yapın oradan cizim alanının biçimlendire gelin orada stil renk kalınlık yerleri var renklerden istediğinizi secin kolay gelsin

çubuk grafiğindeki renklendirmeyi çizgi grafiğinde yapmak münkün mü?

blazer2004

blazer2004

Ferhat Pazarçevirdi

Özel Üye

blazer2004

Ferhat Pazarçevirdi

Özel Üye

Ekli dosyalar

blazer2004

Ferhat Pazarçevirdi

Özel Üye

blazer2004

Ferhat Pazarçevirdi

Özel Üye

blazer2004

Ferhat Pazarçevirdi

Özel Üye

blazer2004

parametre

Destek Ekibi