Excel Makro ve PPT sunum ilişkisi

[Kemal Demir]

Arkadaşlar iyi günler,

Bahsediceğim konu hakkında bilgisi olan yada benzer çalışmaları olan arkadaslar örneklerini benle paylaşabilirler mi?

Ek'teki *.rar dosyası içerisinde bir klasor ve içerisinde *.xls ve *.ppt dosyaları mevcut.
Excel dosyası içerisinde 3 adet sheet var.Bu sheetler ppt dosyasının slide numaralarını vermektedir.

Her bir xls dosyasında a1:f10 ( değişken olabilir ) aralıgını kopyalayarak *.ppt dosyasının ilgili slide larını yapıstırma işlemlerini gerçekleştirecek bir Vba kodunu nasıl olusturabiliriz.

Bu konuda bilgi sahibi olan arkadaslardan yardımcı olabilirler mi?

Teşekkurler iyi çalışmalar.

 

[uzmanamele]

merhaba
syn Rakkas, aşağıdaki linkler konu ile ilgili sanıyorum, belki işiniza yarar bişeyler vardır.

http://www.pcreview.co.uk/forums/thread-1621457-1.php
http://www.dbforums.com/archive/index.php/t-901140.html

 

[Kemal Demir]

Merhaba,

Yok demek istemiyorum, ama bulamadım.Zannedersem biraz daha fazla aramam lazım.

Çözüm önerilerinizi bekliyorum.

İyi çalışmalar.

 

[Haluk]

Merhaba;

Söz konusu PowerPoint dosyanız açık durumdayken, aşağıdaki kodları Excel dosyanıza yerleştirip, çalıştırın.

Sub Test()
    Dim objPPT As Object
    Dim objSlide As Object
    Dim i As Integer
    
    Set objPPT = GetObject(, "Powerpoint.Application")
    objPPT.ActiveWindow.ViewType = 1
    
    For i = 1 To Sheets.Count
        objPPT.ActiveWindow.View.GotoSlide Index:=i
        Set objSlide = objPPT.ActivePresentation.Slides(i)
        Sheets(i).Range("A1:F10").CopyPicture Appearance:=xlScreen, Format:=xlPicture
        objSlide.Shapes.Paste.Select
        objPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        objPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    Next
    Set objSlide = Nothing
    Set objPPT = Nothing
End Sub

 

[uzmanamele]

merhaba
efsane geri döndü :bravo: :bravo:

 

[Kemal Demir]

Hocam nedesem

TEK KELİME İLE SÜPERSİNİZ.

Birşey daha sormak istiyorum.Excel'den tasınıpta kopyalanacak slide ler Excel dosyasının sheet isimleri ile aynı olmalı.
Örnek : Slide (2,5 ve 8 ) kopyalanmalı.

Teşekkurler.

 

[Haluk]

Teşekkür ederim beyler;

Sayın Rakkas, aslında bahsettiğiniz konuyu siz orjinal sorunuzda belirtmişiniz de ben atlamışım.

Bu durumda aşağıdaki gibi bir kod kullanabilirsiniz....

Sub Test()
    Dim objPPT As Object
    Dim objSlide As Object
    Dim i As Integer, j As Integer
    
    Set objPPT = GetObject(, "Powerpoint.Application")
    objPPT.ActiveWindow.ViewType = 1
    
    For j = 1 To objPPT.ActivePresentation.Slides.Count
        objPPT.ActiveWindow.View.GotoSlide Index:=j
        Set objSlide = objPPT.ActivePresentation.Slides(j)
        For i = 1 To Sheets.Count
            If Sheets(i).Name = j & "" Then
                Sheets(i).Range("A1:F10").CopyPicture Appearance:=xlScreen, Format:=xlPicture
                objSlide.Shapes.Paste.Select
                objPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
                objPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
            End If
        Next
     Next
     
    Set objSlide = Nothing
    Set objPPT = Nothing
End Sub

 

[Kemal Demir]

Haluk Bey,

Teşekkur ederim.

İyi çalışmalar. ( Gun içerisinde bukadar soru yeter )