| Blog Office VBA | Blog Excel | Blog Access |
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
.com