TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
این کد از کاربر سئوال می کند : می خواهد در هر پرزنتیشن چند اسلاید وجود داشته باشد. سپس پرزنتیشن را به تکه های متعددی تقسیم می کند و هر تگه را به عنوان یک پرزنتیشن جدید ذخیره می کند. به عنوان مثال:MySlides.PPT دارای 55 اسلاید است که هر 25 اسلایدش در یک پرزنتیشن قرار است قرار بگیرد. و به این ترتیب خواهیم داشت:
- MySlides_1-25.PPT
- MySlides_26-50.PPT
- MySlides_51-55.PPT
Sub SplitFile() 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