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

[blazer2004]

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]

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

[Ferhat Pazarçevirdi]

Ekteki örneği inceleyiniz.

[blazer2004]

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

[Ferhat Pazarçevirdi]

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.

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]

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]

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.

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]

ç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]

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]

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ı) 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]

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.

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

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

With .Axes(xlValue)
.MinimumScale = 150
.MaximumScale = 360
.MajorUnit = 10
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ı :

.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;

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]

ç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]

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 :)