Last active
September 22, 2016 08:48
-
-
Save tdalon/c25b2e71553217599b95f9f631316732 to your computer and use it in GitHub Desktop.
PowerPoint VBA: Move sections selected by slides
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub MoveSelectedSections() | |
' Slides are copied ready to be pasted | |
Dim lngNewPosition As Long | |
'Debug.Print "" | |
'Debug.Print "###Move Sections..." | |
lngNewPosition = InputBox("Enter a destination section index:") | |
lngNewPosition = CInt(lngNewPosition) ' Convert String to Int | |
Call MoveSectionsSelectedBySlides(ActivePresentation, lngNewPosition) | |
End Sub | |
Function MoveSectionsSelectedBySlides(oPres As Presentation, lNewPosition As Long) | |
On Error GoTo errorhandler | |
' Activate input presentation | |
oPres.Windows(1).Activate | |
' Get Selected Sections Indexes | |
' http://www.thespreadsheetguru.com/the-code-vault/2014/4/3/copy-selected-slides-into-new-powerpoint-presentation | |
Dim i, cnt As Integer | |
Dim SelectedSlides As SlideRange | |
Dim SectionIndexes() As Long | |
If ActiveWindow.Selection.Type <> ppSelectionSlides Then | |
MsgBox "No slides selected" | |
Exit Function | |
End If | |
Set SelectedSlides = ActiveWindow.Selection.SlideRange | |
' selection order is reverse see http://www.pptfaq.com/FAQ00869_Create_a_custom_show_from_current_slide_selection_using_VBA.htm | |
'Fill an array with sectionIndex numbers | |
ReDim SectionIndexes(1 To SelectedSlides.Count) | |
cnt = 0 | |
For i = 1 To SelectedSlides.Count | |
' Check if already present in array | |
If Not Contains(SectionIndexes, SelectedSlides(i).sectionIndex) Then | |
cnt = cnt + 1 | |
SectionIndexes(cnt) = SelectedSlides(i).sectionIndex | |
End If | |
Next i | |
ReDim Preserve SectionIndexes(1 To cnt) | |
' Move Sections to lNewPosition, first last | |
For i = 1 To cnt | |
With oPres | |
.SectionProperties.Move SectionIndexes(i), lNewPosition | |
End With | |
Debug.Print "Section #" & SectionIndexes(i) & " moved to " & lNewPosition | |
Next i | |
Exit Function | |
errorhandler: | |
Debug.Print "Couldn't move section due to the following error: " & Err & ", " & Err.Description | |
End Function | |
Function Contains(arr, v) As Boolean | |
' http://stackoverflow.com/a/18769246/2043349 | |
Dim rv As Boolean, i As Long ' Default value of boolean is False | |
For i = LBound(arr) To UBound(arr) | |
If arr(i) = v Then | |
rv = True | |
Exit For | |
End If | |
Next i | |
Contains = rv | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment