PowerPoint でslide追加名前を付けて保存

とにかく今日はうまく行けるところまで頑張ります

Sub 新しいスライドを追加する()
Dim i As Long
i = 1
Do While i <= 5
With ActivePresentation.Slides
.AddSlide _
Index:=.Count + 1, _
pCustomLayout:=.Item(.Count).CustomLayout
End With
i = i + 1
Loop
ActivePresentation.SaveAs "C:\Users\PowerPoint\" & "大好きお願い" & Day(Date) & Hour(Time) & Minute(Time) & ".pptx", ppSaveAsDefault, msoCTrue
ActivePresentation.Close
End Sub