VBA Powerpoint - Divida uma grande apresentação em conjuntos menores - Break a presentation up into several smaller presentations

Blog Office VBA | Blog Excel | Blog Access |
Inline image 2

Um possível problema do seu Cliente seja o de ter inúmeras apresentações que se tornaram grandes demais para se fazer as manutenções tais como re-escrever os textos dos Slides, colar novas fotos e imagens, tabelas, argumentos, enfim, quaisquer alterações necessárias aos profissionais do MS Powerpoint.

Talvez você tenha uma grande apresentação que está ficando tão grande que leva uma eternidade para abrir e salvar cada vez que precisa fazer uma mudança, além de ser enorme para enviar por e-mail.

Que tal dividí-la em várias apresentações menores? Pode fazer isso manualmente, é claro, fazer várias cópias da sua apresentação original (certificando-se de que não vai perder nada), abrir uma a uma e apagar todos os Slides inúteis aquele respectivo conjunto. 

Sim isso pode ser muito bom! Mas será ainda melhor se  deixar o VBA fazer o trabalho para você automaticamente. 

Este código vai perguntar quantos slides quer por apresentação, e em seguida, dividirá a apresentação em várias sub-apresentações, cada uma com o número de slides que solicitou, cada uma nomeada para refletir os números de slides que contém. Por exemplo, sua apresentação BernardesSlides.PPT original contém 55 slides e a SplitFile a dividirá em 25 Slides por arquivo, terá: 
BernardesSlides_1-25.PPT
BernardesSlides_26-50.PPT
BernardesSlides_51-55.PPT 

Os novos arquivos serão salvos na mesma pasta que o arquivo original e o original não será alterado.


Sub SlideSplitFile()
    Dim lSlidesPerFile As Long
    Dim lTotalSlides As Long
    Dim oSourcePres As Presentation
    Dim otargetPres As Presentation
    Dim sFolder As String
    Dim sExt As String
    Dim sBaseName As String
    Dim lCounter As Long

    Dim lPresentationsCount As Long     ' how many will we split it into
    Dim x As Long
    Dim lWindowStart As Long
    Dim lWindowEnd As Long
    Dim sSplitPresName As String

    On Error GoTo ErrorHandler

    Set oSourcePres = ActivePresentation
    If Not oSourcePres.Saved Then
        MsgBox "Please save your presentation then try again"
        Exit Sub
    End If

    lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
    lTotalSlides = oSourcePres.Slides.Count
    sFolder = ActivePresentation.Path & "\"
    sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
    sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)

    If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
        lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
    Else
        lPresentationsCount = lTotalSlides \ lSlidesPerFile
    End If

    If Not lTotalSlides > lSlidesPerFile Then
        MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
        Exit Sub
    End If

    For lCounter = 1 To lPresentationsCount

        ' which slides will we leave in the presentation?
        lWindowEnd = lSlidesPerFile * lCounter
        If lWindowEnd > oSourcePres.Slides.Count Then
            ' odd number of leftover slides in last presentation
            lWindowEnd = oSourcePres.Slides.Count
            lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
        Else
            lWindowStart = lWindowEnd - lSlidesPerFile + 1
        End If

        ' Make a copy of the presentation and open it
        sSplitPresName = sFolder & sBaseName & _
               "_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
        oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
        Set otargetPres = Presentations.Open(sSplitPresName, , , True)

        With otargetPres
            For x = .Slides.Count To lWindowEnd + 1 Step -1
                .Slides(x).Delete
            Next
            For x = lWindowStart - 1 To 1 Step -1
                .Slides(x).Delete
            Next
            .Save
            .Close
        End With

    Next    ' lpresentationscount

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox "Error encountered"
    Resume NormalExit
End Sub

Reference: 

Tags: VBA, Powerpoint, Break, presentation, smaller, presentations, apresentações, dividir, apresentação, Slides




Nenhum comentário:

Postar um comentário

diHITT - Notícias