• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

grafikte otomatik renklendirme

  • Konbuyu başlatan Konbuyu başlatan peral
  • Başlangıç tarihi Başlangıç tarihi
P

peral

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
 
peral' Alıntı:
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
Genişletmek için tıkla ...



Ekteki örneği inceleyin.

..
 
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
 
bu k&#305;s&#305;mda hata verdi

If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
 
run time error 91
object variable or with block variable not set diye hata verdi
 
peral' Alıntı:
bu k&#305;s&#305;mda hata verdi

If ActiveChart.SeriesCollection(1).DataLabels(i).Text < 90000 Then
Genişletmek için tıkla ...

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


.
 
Sondaki

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

.PatternColorIndex = xlNone
 
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.
 
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
 
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ı
 
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
 
&#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...
 
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:
Sonuna End Sub koymam&#305;&#351;&#305;m.Kopyala-yap&#305;&#351;t&#305;r&#305;n azizli&#287;i.Kodu d&#252;zelttim.
 
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..
 
kod nas&#305;l yaz&#305;l&#305;r m&#252;mk&#252;nm&#252;d&#252;r acaba yard&#305;m edermisiniz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst