Moving slide to end but keeping the view where it was
Hello,
I have a macro to move selected slides to the end of the presentation. (I think parts of it came from this forum, but I wasn't able to find the old thread. Sorry.)
Moving the selected slides to the end works well in all PPT versions of the last 10 years, as far as I know, but there is one detail, the newer versions (2016 an newer) handle in a different way then the older ones do.
The detail concerns the active view. E.g.: If I have 10 slides, am looking at p3 and click the macro, in PPT2010 I see the content of p4, because that is the new p3 then. In the newer versions I look at p10 - which is my old p3 at the end of the presentation.
The question: How can I change the code to make it work in the newer versions the same way as it is working in the old? The old way is the preferred way - keeping the view at (the then new) p3 in our example. And: Is there a solution for both, old and new, or do I have to use this macro for the older versions and a slightly different one (we hopefully find) for newer? Any help is welcome! Thank you!
Code:
Option Explicit
Sub MoveToEnd()
Dim Pres As Presentation
Dim sld As Slide
Dim phd As Shape
Dim shp As Shape
Dim iCount As Integer
Set Pres = ActivePresentation
For Each sld In ActivePresentation.Slides
If sld.Tags("BACKUPDIVIDER") = "YES" Then
iCount = iCount + 1
End If
Next sld
Select Case iCount
Case Is > 0
ActiveWindow.Selection.SlideRange.Cut
Pres.Slides.Paste -1
DoEvents
Case 0
Set sld = Pres.Slides.Add(Pres.Slides.Count + 1, ppLayoutBlank)
sld.Tags.Add "BACKUPDIVIDER", "YES"
Set phd = Application.ActivePresentation.SlideMaster.Shapes.Placeholders(2)
Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=0, Top:=10, Width:=10, Height:=10)
With shp
.Fill.Visible = msoTrue
.Fill.Transparency = 0
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 0.75
End With
If ActiveWindow.Presentation.PageSetup.SlideSize = ppSlideSizeOnScreen16x9 Then
With shp
.Top = 215.14947
.Height = 32.031476
.TextFrame2.TextRange.Font.Size = 16
End With
Else
With shp
.Top = 287.71635
.Height = 35.999977
.TextFrame2.TextRange.Font.Size = 18
End With
End If
With shp
With .TextFrame2
With .TextRange
With .Font
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Name = "Arial"
.Bold = msoTrue
.Italic = msoFalse
.UnderlineStyle = msoNoUnderline
End With
.Text = "Backup"
.Paragraphs.ParagraphFormat.Alignment = msoAlignLeft
End With
.VerticalAnchor = msoAnchorMiddle
.Orientation = msoTextOrientationHorizontal
.MarginBottom = 5
.MarginLeft = 5
.MarginRight = 0
.MarginTop = 5
.WordWrap = msoTrue
End With
.Left = phd.Left
.Width = phd.Width
End With
ActiveWindow.Selection.SlideRange.Cut
DoEvents
Pres.Slides.Paste -1
DoEvents
End Select
End Sub
