PowerPoint VBA для сохранения исходного форматирования в целевом PowerPoint

Question

У меня есть следующий код для копирования указанных c слайдов (на основе тегов) в новую презентацию. Я хочу сохранить форматирование исходной презентации в скопированных слайдах целевой презентации.

Текущий код:

Option Explicit
Private Sub CommandButton1_Click()

Dim strTagName As String
Dim strTagValue As String

strTagName = "pname"
strTagValue = "Azure"

Dim currentPresentation As Presentation
Dim newPresentation As Presentation
Dim s As Slide

' Save reference to current presentation
Set currentPresentation = Application.ActivePresentation

' Save reference to current slide
'Set currentSlide = Application.ActiveWindow.View.Slide

' Add new Presentation and save to a reference
Set newPresentation = Application.Presentations.Add

For Each s In currentPresentation.Slides
    If s.Tags(strTagName) = "Azure" Then

    s.Copy
    newPresentation.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

    End If

Next

newPresentation.SaveAs (currentPresentation.Path & "\" & strTagValue & "_Quals Slides.pptx")

End Sub

Answer 1

Option Explicit
Private Sub CommandButton1_Click()

Dim strTagName As String
Dim strTagValue As String

strTagName = "pname"
strTagValue = "Azure"

Dim currentPresentation As Presentation
Dim newPresentation As Presentation
Dim s As Slide

' Save reference to current presentation
Set currentPresentation = Application.ActivePresentation

' Save reference to current slide
' Set currentSlide = Application.ActiveWindow.View.Slide

' Add new Presentation and save to a reference
Set newPresentation = Application.Presentations.Add

For Each s In currentPresentation.Slides
    If s.Tags(strTagName) = "Azure" Then

    s.Copy
    newPresentation.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
    For i = 1 To 5000: DoEvents: Next

    End If

Next

newPresentation.SaveAs (currentPresentation.Path & "\" & strTagValue & "_Quals Slides.pptx")

End Sub