grafikte otomatik renklendirme

Katılım
28 Haziran 2007
Mesajlar
86
Excel Vers. ve Dili
365
arkadaşlar,gönderdiğim ekte grafik çalışma sayfasındaki çubuk grafikte üretim miktarı 90.000 adet ve üzerinde çubuk un rengi otomatik olarak yeşil renk,90.000 adet altındaki üretimlerde kırmızı renk olmasını istiyorum,ben tek tek elle bu renkleri değiştiriyorum.bunu otomatik olarak yapabilirmiyiz,teşekkürler
 

Merhum İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
17,094
Excel Vers. ve Dili
Excel, 365 - İngilizce
arkadaşlar,gönderdiğim ekte grafik çalışma sayfasındaki çubuk grafikte üretim miktarı 90.000 adet ve üzerinde çubuk un rengi otomatik olarak yeşil renk,90.000 adet altındaki üretimlerde kırmızı renk olmasını istiyorum,ben tek tek elle bu renkleri değiştiriyorum.bunu otomatik olarak yapabilirmiyiz,teşekkürler


Ekteki örneği inceleyin.

..
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Aşağıdaki kodu Grafik sayfasının kod kısmına ekleyin.
Not:Sayfayı her etkinleştirdiğinizde kod çalışacaktır.

Kod:
Private Sub Worksheet_Activate()
For i = 4 To 30
If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 3
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
Else
        With Selection.Interior
        .ColorIndex = 4
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
End If
Next
End Sub
 
Katılım
28 Haziran 2007
Mesajlar
86
Excel Vers. ve Dili
365
bu k&#305;s&#305;mda hata verdi

If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
 
Katılım
28 Haziran 2007
Mesajlar
86
Excel Vers. ve Dili
365
run time error 91
object variable or with block variable not set diye hata verdi
 

Merhum İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
17,094
Excel Vers. ve Dili
Excel, 365 - İngilizce
bu k&#305;s&#305;mda hata verdi

If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
Kodlar&#305; a&#351;a&#287;&#305;daki &#351;ekilde deneyin.


Private Sub Worksheet_Activate()
Application.ScreenUpdating =False
For i = 4 To 30
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.ChartArea.Select
If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
ActiveChart.SeriesCollection(1).Points(i).Select
With Selection.Interior
.ColorIndex = 3
.PatternColorIndex = 3
.Pattern = xlSolid
End With
Else
With Selection.Interior
.ColorIndex = 4
.PatternColorIndex = 3
.Pattern = xlSolid
End With
End If
Next
Application.ScreenUpdating = True
End Sub


.
 

Merhum İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
17,094
Excel Vers. ve Dili
Excel, 365 - İngilizce
Sondaki

.PatternColorIndex = 3 kodunu a&#351;a&#287;&#305;daki &#351;ekilde de&#287;i&#351;tirin.

.PatternColorIndex = xlNone
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Yaptığım örneği tekrar inceledim. Şimdilik doğru çalışmıyor. Bu yüzden Sayın yurttas'ın verdiği örneği kullanmanızı tavsiye ederim. Olması gereken de bence bu.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Bir önceki measajımda belirttiğim gibi, size tavsiyem Sayın yurttas'ın örneği. Çünkü, herzaman Excel'in mevcut özelliklerinden faydalanmak en doğrusu. Bu yüzden, yaptığım kodu, alternatif olarak düşünmenizi dilerim. Önceki kod üzerinde değişikliler yaptım. Galiba şimdi doğru çalışıyor. Ama yine belirteyim, öncelikle Sayın yurttas'ın örneğini kullanın.

Kod:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
ActiveSheet.ChartObjects("Grafik 3").Activate
For i = 1 To 30
deger = Val(ActiveChart.SeriesCollection(1).DataLabels(i).Text)
If deger < 90 Then
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 3
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
Else
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 4
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
End If
Next
[a1].Select
Application.ScreenUpdating = True
End Sub
 
Katılım
28 Haziran 2007
Mesajlar
86
Excel Vers. ve Dili
365
en son gönderdiğiniz oldu fakat üretkenlik A vardiyası grafiğinde program çalışırken,diğerlerinde (B ve C vardiyası grafiğinde) değişiklik olmadı
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Aşağıdaki şekilde dener misiniz?
Kod:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
For a = 1 To 3
ActiveSheet.ChartObjects(a).Activate
For i = 1 To 30
deger = Val(ActiveChart.SeriesCollection(1).DataLabels(i).Text)
If deger < 90 Then
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 3
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
Else
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 4
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
End If
Next i
Next a
[a1].Select
Application.ScreenUpdating = True
End Sub
 
Katılım
28 Haziran 2007
Mesajlar
86
Excel Vers. ve Dili
365
&#231;ok te&#351;ekk&#252;r ederim,son bir sorum olacak &#252;retkenlik-A,B,C vardiyas&#305; grafiklerinde s&#305;n&#305;r olarak 90.000 adet olarak renklendirme yapt&#305;k,en altta &#252;rekenlik toplam grafi&#287;i var,bu grafik de 3 vardiyan&#305;n toplam&#305;n&#305; g&#246;steriyor,burdaki s&#305;n&#305;r de&#287;erimiz 270.000 adet bunu nas&#305;l yapar&#305;z?yard&#305;mlar&#305;n&#305;z ve ilginiz i&#231;in te&#351;ekk&#252;rler...
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
A&#351;a&#287;&#305;daki &#351;ekilde deneyin.
Kod:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
For a = 1 To 4
ActiveSheet.ChartObjects(a).Activate
For i = 1 To 30
deger = Val(ActiveChart.SeriesCollection(1).DataLabels(i).Text)
If deger < 90 Then
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 3
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
ElseIf a = 4 And deger < 270 Then
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 3
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
Else
ActiveChart.SeriesCollection(1).Points(i).Select
    With Selection.Interior
        .ColorIndex = 4
        .PatternColorIndex = 3
        .Pattern = xlSolid
    End With
End If
Next i
Next a
End Sub
 
Son düzenleme:

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,737
Excel Vers. ve Dili
Excel 2019 Türkçe
Sonuna End Sub koymam&#305;&#351;&#305;m.Kopyala-yap&#305;&#351;t&#305;r&#305;n azizli&#287;i.Kodu d&#252;zelttim.
 
Katılım
23 Şubat 2007
Mesajlar
131
Excel Vers. ve Dili
excel2003
arkadaşlar bir sorum olacak peki bu grafik üzerinde alt limitte kırmızı ideal limitte ise yeşil yapma makrosu ben bunu çubuk grafik değilde çizgi grafiğinde uygulayabilirmiyim..
 
Katılım
1 Ekim 2008
Mesajlar
19
Excel Vers. ve Dili
2003 türkçe
kod nas&#305;l yaz&#305;l&#305;r m&#252;mk&#252;nm&#252;d&#252;r acaba yard&#305;m edermisiniz
 
Üst