Grafik üzerine açıklama ekleme

[nerodale@yahoo.com]

Arkadaşlar merhaba,

Ben ekteki gibi bir grafik oluşturdum. Ve grafikte bir serinin üzerine gelindiğinde grafiğin üst kısmında oluşturduğum metin kutusunun içine başka bir alanda oluşturduğum metinlerin gelmesini istiyorum. Örneğin, eylül ayının 2008 verimlilik değerinin üstüne gelip 1 sn beklersem mouse ile grafiğin üstündeki metin kutusunda "Yeni açılan mağaza etkisi" yada "Kadro değişimi" gibi başka bir alanda oluşturduğum metinler gözüksün.. Normalde hücrelere comment eklemenin grafik üzerindeki değerlere uygulanması gibi bişey.

Bu şekilde bir kod oluşturulabilir mi? Yardımlarınız için şimdiden teşekkür ederim.

 

[nerodale@yahoo.com]

Arkadaşlar makro yerine alternatif bi çözüm falan önerebilecek kimse yok mu??

 

[Ferhat Pazarçevirdi]

Ekteki örnek dosyayı inceleyiniz.

Mouse imleci, açıklama barındıran bir aya ve yıla gelirse, üst taraftaki text kutusuna, daha önceden girdiğiniz not yazdırılır.

Bu olayın gerçekleşmesi için, grafiğin önceden aktif hale getirilmesi (seçilmesi) gereklidir.

Sayfa üzerine gömülmüş grafik nesneleri normal olarak Mouse_Move olayını desteklemez. Bunun için; bir class module kullanılarak, dosya açılışında, istenen grafik nesnesinin eskizi çıkarılmış ve olay bağlantısı yapılmıştır.

Class Module İsmi : Grafik_Olaylari

Public WithEvents ChartObject As Chart
Dim lEski_a As Long
Dim lEski_b As Long
Private Sub ChartObject_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    
    Dim IDNum As Long
    Dim VeriNoktasi As Point
    Dim rng As Range
    Dim i As Long
    Dim a As Long
    Dim b As Long
    
    ChartObject.GetChartElement x, y, IDNum, a, b
    
    If lEski_a = a And lEski_b = b Then Exit Sub
    
    If IDNum = xlSeries Then
        
        Set VeriNoktasi = ChartObject.SeriesCollection(a).Points(b)
        
        If Range("A65536").End(xlUp).Row >= 22 Then
            
            For i = 22 To Range("A65536").End(xlUp).Row
                
                If CStr(Range("A" & i)) = VeriNoktasi.Parent.Name _
                    And _
                        CStr(Range("B" & i)) = WorksheetFunction.Index(ChartObject.SeriesCollection(a).XValues, b) Then
                    
                    ChartObject.Shapes("Text Box 1").TextFrame.Characters.Text = Range("C" & i)
                    
                    Exit Sub
                End If
            
            Next i
        Else
            
            ChartObject.Shapes("Text Box 1").TextFrame.Characters.Text = ""
        
        End If
    
    Else
        
        ChartObject.Shapes("Text Box 1").TextFrame.Characters.Text = ""
    
    End If
    
    lEski_a = a
    lEsli_b = b
    
    Set VeriNoktasi = Nothing
End Sub

Private Sub Class_Terminate()
    Set ChartObject = Nothing
End Sub

Daha sonra; standart bir module sayfası ekleyerek aşağıdaki kodlar dahil edilir.

Dim GrafikNesneSinifi As New Grafik_Olaylari
Sub Auto_Open()
    Set GrafikNesneSinifi.ChartObject = Worksheets(1).ChartObjects(1).Chart
End Sub

 

[nerodale@yahoo.com]

Çok teşekkür ederim. Tam istediğim gibi bir uygulama olmuş. Kodları inceleyip düzenlemeye çalışacağım. Tekrar teşekkürler..

 

[Levent Menteşoğlu]

Ferhat bey tebrik ederim çok güzel bir örnek, bu çözümü arşivime aldım. Çözümünüzü inceleyince benimde aklıma chartspace nesnesinin kullanılması geldi. Bu nesnenin direk mouse_move olayından faydalanılabilir. Bu nesnede de sorun, verileri direk excel hücrelerinden alamıyor olmasıdır. Bu konu üzerinde de ben bir çalışma yapayım. Sonuç elde edebilirsem, güzel bir arşiv elde etmiş oluruz.

 

[Ferhat Pazarçevirdi]

Haklısınız Levent bey... Normal Excel sheet ve grafiklerine karşı, OWC'lerde çok daha fazla event var. Kodlama daha rahat olabilir. Bitirdiğinizde yayınlayabilirseniz, grafiklere yeni ve farklı bir bakış açısı yaratacağına eminim ...

Ben daha önce ChartSpace nesnesini sayfa üzerinde kullanmadım hiç ...

NOT : Aklıma geldi ... Microsoft'un bir tane daha Chart nesnesi vardı ... Belki o da denenebilir. Adı aklıma gelmedi kusura bakmayın. Ms Chart gibi birşeydi sanırım ..

 

[Levent Menteşoğlu]

Chartspace nesnesi ile uzun uğraşılardan sonra hazırladığım dosyayı ekte sunuyorum. Dosya açıldığında aşağıdaki gibi bir uyarı mesajı alırsanız bir altta vereceğim kodu sadece bir kez çalıştırınız.

This Application is about yo initialize ActiveX controls that might be unsafe.If you trust the source of this file, select OK and the controls will be initialized using your current workspace settings.

[LEFT][COLOR=black]Sub regolustur()[/COLOR]
[COLOR=black]Dim deg As Object[/COLOR]
[COLOR=black]anahtar = "HKCU\Software\Microsoft\VBA\Security\LoadControlsInForms"[/COLOR]
[COLOR=black]Set deg = CreateObject("WScript.Shell")[/COLOR]
[COLOR=black]deg.RegWrite anahtar, 1, "REG_DWORD"[/COLOR][/LEFT]
[COLOR=black]End Sub[/COLOR]

Dosyada kullanılan kodlar aşağıdaki gibidir.
Sayfaya bir chartspace nesnesi ekledikten sonra,​

Nesneye verileri, sayfadaki tablodan yükleyen prosedür için normal bir module:

Public deg As New Spreadsheet

Sub auto_open()
deg.Range("b3:d15").Value = Sayfa1.Range("b3:d15").Value
With Sayfa1.ChartSpace1
.DataSource = deg
With .Charts(0)
.Type = chChartTypeLineMarkers
With .SeriesCollection(0)
.SetData chDimCategories, 0, "B4:B15"
.SetData chDimValues, 0, "C4:C15"
End With
With .SeriesCollection(1)
.SetData chDimCategories, 0, "B4:B15"
.SetData chDimValues, 0, "D4:D15"
End With
End With
End With
End Sub

Nesnenin mouse_move olayının çalışması ve veriler değiştiğinde güncelleme yapmak içinde sayfanın kod sayfasına:

Private Sub ChartSpace1_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Sayfa1.Shapes("metin").TextFrame.Characters.Text = ""
If TypeName(Sayfa1.ChartSpace1.RangeFromPoint(x, y)) <> "ChPoint" Then Exit Sub
yil = Sayfa1.ChartSpace1.RangeFromPoint(x, y).GetValue(chDimSeriesNames)
ay = Sayfa1.ChartSpace1.RangeFromPoint(x, y).GetValue(chDimCategories)
For a = 22 To [a65536].End(3).Row
If Cells(a, "a") = CDbl(yil) And Cells(a, "b") = ay Then
Sayfa1.Shapes("metin").TextFrame.Characters.Text = Cells(a, "c")
End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c4:d15]) Is Nothing Then Exit Sub
auto_open
End Sub

 

[ersoyalan]

Ferhat hocam ve Levent hocam araya giriyorum fakat oldukça güzel çalışmalar yapmışsınız.Ellerinize sağlık aradığım bir konuydu bu vesileyle bende işimi görmüş oldum.

Teşekkür eder.

Syg,
iyi çalışmalar.
E.ALAN

 

[1Al2Ver]

Hata mesajı

Merhaba,

Benim PC'den kaynaklanan bir eksiklikten dolayı hata almaktayım, nasıl bir düzenleme yapmalıyım ?

Teşekkür ederim.

 

[rhombeus]

Gerçekten süper bir çalışma, teşekkürler...

 

[1Al2Ver]

Günaydın,

Sorunum için önerilerinizi bekliyorum,

Teşekkür ederim.

 

[1Al2Ver]

Merhaba,

Benim PC'den kaynaklanan bir eksiklikten dolayı hata almaktayım, nasıl bir düzenleme yapmalıyım ?

Teşekkür ederim.

Merhaba,

Önerisi olan var mı ?

Teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Merhabalar,

Bu linke tıklayınız ve OWC11 kurulum dosyasını indiriniz ve çalıştırınız.

Problem, bilgisayarınızda OWC11 paketinin kurulu olmamasından kaynaklanıyor.

İndirme ve kurulum işlemi tamamladığınızda, problem hallolacaktır.

Not : Mesela, bende de V.11 kurulu değil (hala V.10'a demirledik) ve aynı hatayı alıyorum.

İyi çalışmalar

.

 

[1Al2Ver]

Merhabalar,

Bu linke tıklayınız ve OWC11 kurulum dosyasını indiriniz ve çalıştırınız.

Problem, bilgisayarınızda OWC11 paketinin kurulu olmamasından kaynaklanıyor.

İndirme ve kurulum işlemi tamamladığınızda, problem hallolacaktır.

Not : Mesela, bende de V.11 kurulu değil (hala V.10'a demirledik) ve aynı hatayı alıyorum.

İyi çalışmalar

.

Sayın Ferhat Pazarçevirdi merhaba,

Duyarlığınız ve yardımınız için sonsuz teşekkür ederim,

Saygılarımla.

 

[eda82]

Hayırlı günler,
Grafiğin ve kodların mantığını anlamaya çalışıyorum.Fakat kendim uyarlayamadım.Örneğim ektedir.
Neyi yanlış yapıyorum.Bana bilgi verebilirseniz çok sevinirim?

Tekrar hayırlı günler.
Eda.

 

[eda82]

Merhaba ,
Bu konuda bana yardımcı olabilirseniz çok sevinirim?

 

[Levent Menteşoğlu]

Dosyanıza chartspace nesnesini eklememişsiniz. Ben gerekli eklemeyi yaptım. Ekte inceleyebilirsiniz.

 

[Merhum İdris SERDAR]

.

Bu da başka bir bakış açısı ile...


.

 

[eda82]

Merhaba Levent ,
Ben grafiği inceledim.Ekteki hatayı alıyorum.Ne yapmam gerekiyor?
Yardımcı olabilirseniz sevinirim...

 

[eda82]

Merhaba Yurttaş,
2008-2007 aynı grafikte gösterilemez mi?
Ayrıca o grafiği nasıl yaptığınızı ,notları nasıl eklediğinizi bana anlatabilirseniz çok sevinirim.