Power Point de birden fazla ppt dosyasını tek bir ppt dosyasına almak

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Merhaba Arkadaşlar,

Elimde 100 ün üzerinde farklı başlıklarda ppt dosyaları mevcut.
Yapmak istediğim şey bu 100 tane dosyayı önce birleştirip tek bir ppt içerisine almak. 100 ppt den herbiri farklı sayıda slayt icerebilir ve ben hepsini tek bir ppt ye aldığımda slaytların tamamı sırasıyla tek bir ppt dosyasında birleşecek. Ekle den yeni slayt dediğim zaman sadece tek bir ppt dosyası seçmeme izin veriyor. 100 tane dosya için bunu tek tek yapmak bana fayda getirmeyecek. Çoklu seçim lazım. Bunu nasıl yapabilirim ?

Teşekkürler
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Bahsettiğiniz PowerPoint dosyalarının bilgisayarınızda C:\TestFolder adında bir klasörde olduğunu varsayarsak;

Birleştirmek istediğiniz ana PowerPoint dosyasını açın ve Alt+F11 tuşlayarak VB Editöre ulaşın.

Burada, yeni bir modül ilave ettikten sonra aşağıdaki kodları yapıştırıp, Test isimli makroyu çalıştırın.

Kod:
Sub Test()
    'Haluk 29/05/2018
    Dim strPath As String
    Dim strExt As String
    Dim myFile As String
    
    strPath = "[B][COLOR="Red"]C:\TestFolder\[/COLOR][/B]"
    strExt = "*.PPT*"
    myFile = Dir$(strPath & strExt)
    
    While myFile <> ""
    strFile = strPath & myFile
        ActivePresentation.Slides.InsertFromFile strFile, ActivePresentation.Slides.Count, 1
        myFile = Dir()
    Wend
    
    MsgBox "İşlem tamam..."
End Sub

.
 

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Haluk çok Teşekkür ederim.

Ancak kod sonrası mesajı versede çalışmıyor sonuç alamadım acaba nerede yanlış yapıyorum senin dediğin gibi önce yeni boş bir ppt dosyasında yeni modül içerisine yazdım verdiğin kodu. Sonrasında o ppt dosyasını macro içeren ppt olarak kaydetip kapattım sonra açıp test makrosunu çalıştırdım ancak ilgili klasörde yani benim için C:\Users\Deniz\Desktop\PPT Test klaörüne gidip baktığım ppt lerde bir farklılık yok birleşmedi. Ve bunun haricinde koda başvurmadan bunun çözümü var mı?
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Deniz;

1) strPath degiskenine yazdigin dosya yolunun \ isareti ile bittigine emin ol,

2) Her sey yolunda gittiyse, PPT dosyalarindaki slaytlar kodun yazildigi dosyaya aktarilmis olmasi gerekir.


.
 

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Haluk süper. dediğin gibi syntax hatası yapmışım. Çalıştı istediğim oldu şuan.
tekrar teşekkürler. Şimdi sana ikinci bir soru sormak istiyorum.

Örnek üzerinden açıklayayım.
100 tane ppt dosyasını (her biri 1 tane slayt içeriyor) yazmış olduğun VBA koduyla birleştirip tek bir ppt yaptık. Şimdi ben bunları tekrar en baştaki gibi 100 tane ppt dosyasına ayırmak istiyorum. Sen diyeceksin ki neden birleştirdik. Çünkü masterslayt da bir değişiklik yaparak tek seferde 100 dosyayı da değiştirmiş oldum. Şimdi tekrar ayırmak farklı bir makro ile mümkün mü?
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Şöyle birşey olabilir ....

1) Bilgisayarınızda C:\TestFolder isimli bir klasör olduğunu kabul edersek, (başka boş bir klasör de olabilir .... C:\MyPPTfiles gibi)

2) Aşağıdaki kodu, daha önceki kodla slaytların birleştirilmiş olduğu PPTM dosyasındaki module yapıştırın ve Test2 isimli makroyu çalıştırın.

3) Kodun çalışması bittikten sonra, C:\TestFolder klasöründe (veya C:\MyPPTfiles) PPT1.pptx, PPT2.pptx, ..... PPT99.pptx isimli dosyaların oluşturulmuş olması gerekir.

İlgili kod:

Kod:
Sub Test2()
    'Haluk - 30/05/2018
    Dim myPPT As Presentation, newPPT As Presentation
    Set myPPT = ActivePresentation
    For i = 1 To myPPT.Slides.Count
        Set newPPT = Application.Presentations.Add
        myPPT.Slides.Item(i).Copy
        newPPT.Slides.Paste
        newPPT.SaveAs "[COLOR="Red"]C:\TestFolder[/COLOR]\[COLOR="Blue"][B]PPT[/B][/COLOR]" & i & ".pptx"
        newPPT.Close
    Next
End Sub
.
 

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Haluk Çok teşekkür ederim gerçekten oldu. Umarım VBA kodlamayı ve makroyu bende senin kadar iyi ilerde öğrenip uygulamaya geçirebilirim. Yardımın için tekrar teşekkürler.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Kolay gelsin ...

.
 
Üst