Makro ile grafik çizmek

[incredible]

Merhaba,
Excel de makro ile 50 kadar grafiği otomatik olarak çizmek istiyorum, bu konuda daha önce çalışma yapan oldu mu? Ban fikir verebilir mi?

 

[bedersu]

Merhaba,

Daha önce bu şekilde bir çalışmam olmadı ama grafik verilerinin alındığı yerleri for..next döngüsü içine oturtabilirseniz dediğiniz kolay olur.MEsela;

Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="3-B Sütun"
ActiveChart.SetSourceData Source:=Sheets("Sayfa1").Range("A1")
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = Sheets("Sayfa1").Cells(ii, i)

ActiveChart.SeriesCollection(1).Values = Sheets("Sayfa1").Cells(i, ii)
ActiveChart.SeriesCollection(1).Name = "=""Grafik1"""
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa1"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Grafik1"
End With

burada i ve ii değerlerinin nasıl alınacağını bilmediğim için bir döngü oluşturmadım ama siz biraz düşünerek bunu yapabilirsiniz.Hatta her biri için yeni sayfa adı oluşturabilirsiniz ve sayfa isimlerini "Grafik" & i olarak atarsanız her grafiğin kendi adını taşıyan bir sayfası olur.

 

[incredible]

Verdiğin bilgi için teşekkür ederim, fakat ben her grafiği farklı sayfa da istemiyorum, bir sayfaya 5 tane grafik koymak istiyorum. Aşağıdaki komutlarla örnek bişeyler yaptım fakat ikinci grafiği çizmede sorun yaratıyor, grafikleri üstüste bindiriyor.

Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sayfa1").Range("B4:E4"), PlotBy:= _
xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa2"
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlRight
ActiveSheet.Shapes("Grafik 1").IncrementLeft -138#
ActiveSheet.Shapes("Grafik 1").IncrementTop -65.25
Windows("xxx.xls").SmallScroll Down:=9
ActiveWindow.Visible = False
Windows("xxx.xls").Activate
Range("B20").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sayfa1").Range("B5:E5"), PlotBy:= _
xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa2"
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlRight
ActiveSheet.Shapes("Grafik 2").IncrementLeft -136.5
ActiveSheet.Shapes("Grafik 2").IncrementTop 52.5
End Sub

 

[Kemal Demir]

Değerli Arkadaslar,

Yapmak İsteyipte yapamadıgım bir konu uzerınde Acıklama Yapmısınız Formu Gezerken Dikkatimi Çekti Elimde Bir ornek var.
Çalışma Durumları İçin Geçerli.

Burada Kişi bazlı Yurutulen İşlerdeki Sonuclandırma ile ilgili Kişi Bazlı Grafik Yapılabilirmi Eğer Bole Bir İmkan varsa İlgilenirseniz Çok Teşekkur Ederi.

Not Acılan Her Sayfa(A Kolonunda Kişilere Göre Acılması Sağlanabilirmi)

Saygılar.

Dosyayı Ekliyorum.

 

[Kemal Demir]

Değerli Arkadaslar hafta sonunuzu bana ayırın demiyorum ama gondermiş olduğum dosyada yardım aıhtıyacım var yapılması ımkanı varmı yoksa bole bır sey ıstemek biraz UCMAK mıdır.
Saygılar.

 

[Levent Menteşoğlu]

Ekteki örneği inceleyin.

 

[Kemal Demir]

cok güzel ama bunu kodlarla for next dongusu ıle ısımler adı altında sayfa acarak yapabilirmiyiz
Sn Leventm.

 

[Levent Menteşoğlu]

Ekteki dosyayı inceleyin. Ayrıca birde progressbar ekledim.

 

[excile]

Siz muhteşemsiniz Sn.Leventm.Bu benimde çok işime yarayacak. :mutlu:

 

[incredible]

Çok Sağolun sayın Leventm, bu benim işime de çok yarayacak..

 

[Kemal Demir]

Çok teşekkur Ederim. Sn Leventm.

 

[ozgurdenizlioglu]

Ekler?

Bu sayfada ekler yok mu yoksa ben mi göremiyorum?

 

[hsayar]

Ekteki dosyayı inceleyin. Ayrıca birde progress bar ekledim.

hgocam dosya elinizde ise tekrar paylaşırmısınız?

 

[bluefalcon]

evet gerçekten paylaşır mısınız?

 

[Levent Menteşoğlu]

Tüm dosyalar yerlerine eklenmiştir.

 

[uzmanamele]

merhaba
bu örnek dosya benim çok işime yarayacak, teşekkürler syn leventm.
ancak bir sorun var. dosyayı tam inceleyemedim ama aktar butonuna basınca aktarma işlemi 12 dakika sürdü, bu normal mi? benim makinem bu kadar yavaş olamaz.

 

[mami68]

Super olmuş

 

[Levent Menteşoğlu]

merhaba
bu örnek dosya benim çok işime yarayacak, teşekkürler syn leventm.
ancak bir sorun var. dosyayı tam inceleyemedim ama aktar butonuna basınca aktarma işlemi 12 dakika sürdü, bu normal mi? benim makinem bu kadar yavaş olamaz.

Kod uzun işlemler yaptığından süre biraz uzuyor ancak 12 dk anormal bir süre, bende 1,5 dk kadar sürdü. Birara kodu nasıl hızlandırabilirim diye üzerinde çalışırım.

 

[hsayar]

hocam bende 1 dk. sürdü

 

[kpolat]

Hocam; her zamanki gibi süpersiniz. Elinize, aklınıza, yüreğinize sağlık.