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.SeriesCollecti on(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.


Sub regolustur()
Dim deg As Object
anahtar = "HKCU\Software\Microsoft\VBA\Security\LoadControlsI nForms"
Set deg = CreateObject("WScript.Shell")
deg.RegWrite anahtar, 1, "REG_DWORD"
End Sub



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]

Merhaba,

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

Teşekkür ederim.

http://img402.imageshack.us/img402/4295/hataq.png (http://img402.imageshack.us/i/hataq.png/)

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

http://img402.imageshack.us/img402/4295/hataq.png (http://img402.imageshack.us/i/hataq.png/)

Merhaba,

Önerisi olan var mı ?

Teşekkür ederim.

[Ferhat Pazarçevirdi]

Merhabalar,

Bu linke (http://www.microsoft.com/downloads/en/details.aspx?FamilyId=7287252C-402E-4F72-97A5-E0FD290D4B76&displaylang=en) 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 (http://www.microsoft.com/downloads/en/details.aspx?FamilyId=7287252C-402E-4F72-97A5-E0FD290D4B76&displaylang=en) 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.

[yurttas]

.

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.

[Levent Menteşoğlu]

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

VB editönde tools-references menüsünde aşağıdaki referansı işaretleyin.

Microsoft office web components 11.0 veya en üst versiyonu işaretleyin.

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

[yurttas]

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.

.

Açıklamalı dosya ekte.

.

[eda82]

Merhaba Levent Menteşoğlu,
Ben dediğiniz şekilde Microsoft web components en üst verisyonu zaten seçiliydi.Ama gene de hata alıyorum.Ekte dosyaya işaretli olduğunu ekledim.

[Levent Menteşoğlu]

Referansın missing ile başlaması sizde olmadığını gösteriyor. Microsoft office web components 11.0 yerine varsa daha düşük versiyonları deneyin. örneğin, Microsoft office web components 10.0 gibi

[eda82]

Maalesef 10 da yok.Başka bir yolu yok mu?
Teşekkürler

[Levent Menteşoğlu]

Maalesef 10 da yok.Başka bir yolu yok mu?
Teşekkürler

Başka yolu var elbette. Öncelikle 2007 verisiyonunuzun sürümünü arttırabilirsiniz. Yada internette ilgili mscomct2.ocx dosyasını bulup bilgisayarınıza yükleyebilirsiniz.