Yapilan Grafik Otomatik Powerpointe Atma Makro Yardım

[realastala]

Merhaba
Excelde Örnekdeki gibi bir veri oluşturdum,veriye ait hemen altindaki gibi bir grafigin otomatik oluşarak powerpointe otomatik aktarilmasini iceren bir makro varmıdır,buna çok ihtiyacım var,
İlginize Şimdiden Teşekkürler...

 

[serqet]

Aşağıdaki kodu bir butona ekleyin.

Sub ChartsAndTitlesToPresentation()

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String


Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Add
PPApp.ActiveWindow.ViewType = ppViewSlide
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)


Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(iCht).Chart

If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If

.HasTitle = False

.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If
End With


SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide

.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next


Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

 

[serqet]

Referanslardan "Microsoft Powerpoint 14.0 Object Library" eklemeyi unutmayın.

 

[realastala]

Serqet Kodlar için teşekkürler Çalışıyor ama ben bu soruyu şu amaçla sordum benim ekteki gibi 20 tane excel dosyalarinda ayrı ayrı grafiklerim var bunların hepsini birden powerpointte şablonunu hazırladıgım powerpoint sayfalarina siradan 1.grafik 1.powerpoint sayfasına 2.grafik powerpointin 2. sayfasina olacak şekilde nasıl düzenleyebilirim.(tek Butonla)
şimdiden teşekkürler

 

[serqet]

O zaman bu kodu tek tek bütün sayfalarınıza yazacaksınız yada bütün grafiklerinizi tek bir çalışma kitabında toplayıp o şekilde yapacaksınız.