Loop and Send To OneNote

[jtyates]

I am trying to send individual slides to OneNote pages of the same section. If I send a group of slides they all appear on the same page. I want them in the same section, but different page so it means sending one page at a time but advancing through the powerpoint slides. I recorded this macro and it works somewhat. I have other presentations with different number of slides and I'd like to walk through each slide and send it to one note. Can you help?

Here's my code so far:


With ActivePresentation.PrintOptions
.RangeType = ppPrintCurrent
.NumberOfCopies = 1
.Collate = msoTrue
.OutputType = ppPrintOutputSlides
.PrintHiddenSlides = msoTrue
.PrintColorType = ppPrintColor
.FitToPage = msoFalse
.FrameSlides = msoFalse
.ActivePrinter = "Send To OneNote 2007"
End With
ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex + 1).Select
ActivePresentation.PrintOut
With ActivePresentation.PrintOptions
.RangeType = ppPrintCurrent
.NumberOfCopies = 1
.Collate = msoTrue
.OutputType = ppPrintOutputSlides
.PrintHiddenSlides = msoTrue
.PrintColorType = ppPrintColor
.FitToPage = msoFalse
.FrameSlides = msoFalse
.ActivePrinter = "Send To OneNote 2007"
End With
ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex + 1).Select
ActivePresentation.PrintOut
With ActivePresentation.PrintOptions
.RangeType = ppPrintCurrent
.NumberOfCopies = 1
.Collate = msoTrue
.OutputType = ppPrintOutputSlides
.PrintHiddenSlides = msoTrue
.PrintColorType = ppPrintColor
.FitToPage = msoFalse
.FrameSlides = msoFalse
.ActivePrinter = "Send To OneNote 2007"
End With