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!
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