PowerPoint列印簡報為講義模式的頁碼設定

http://itstaffnetwork.blogspot.tw/2012/05/powerpoint-1-1ppt-2-3-4pdfpdf-5vba-1.html







Dim i As Long
Dim lStart As Long
Dim lStop As Long
Dim
lHandoutKind As Long
Dim lSlide As Long
Dim lSlideEnd As Long
Dim
ppHandoutKind As PpPrintOutputType
Dim vbConfirm As
VbMsgBoxResult
'
lSlide = InputBox("從哪一張簡報開始列印？", "開始簡報",
"1")
'
lStart = InputBox("講義起始頁碼編號: ", "講義起始頁碼", "1")
'
lHandoutKind
= InputBox("每頁幾張簡報?" & vbNewLine & "2, 3, 4, 6, 9？", "講義列印類型",
"6")
'
Select Case lHandoutKind
Case 1, 2
ppHandoutKind =
ppPrintOutputTwoSlideHandouts
lHandoutKind = 2
Case 3
ppHandoutKind =
ppPrintOutputThreeSlideHandouts
lHandoutKind = 3
Case 4
ppHandoutKind =
ppPrintOutputFourSlideHandouts
lHandoutKind = 4
Case 5, 6
ppHandoutKind
= ppPrintOutputSixSlideHandouts
lHandoutKind = 6
Case
Else
ppHandoutKind = ppPrintOutputNineSlideHandouts
lHandoutKind =
9
End Select
'
vbConfirm = MsgBox("您已選擇講義列印，每頁投影片張數為" &
lHandoutKind & "張，起始列印頁碼為" & lStart & vbNewLine & "，開始列印頁數為"
& lSlide & ".", vbOKCancel)
'
If vbConfirm = vbOK
Then
'
lStop = Round((ActivePresentation.Slides.Count - (lSlide - 1)) /
lHandoutKind)
If Round((ActivePresentation.Slides.Count - (lSlide - 1)) Mod
lHandoutKind) <= (lHandoutKind / 2) Then
lStop = lStop + 1
End
If
'
For i = 1 To
lStop
'
ActivePresentation.NotesMaster.HeadersFooters.SlideNumber.Visible
=
msoFalse
ActivePresentation.HandoutMaster.Shapes(4).TextFrame.TextRange.Text
= lStart
lStart = lStart + 1
'
With
ActivePresentation.PrintOptions

'
.RangeType =
ppPrintSlideRange
With .Ranges
'
.ClearAll
'
lSlideEnd = lSlide +
lHandoutKind - 1
'
If lSlide > ActivePresentation.Slides.Count
Then
lSlide = ActivePresentation.Slides.Count
End If
If lSlideEnd >
ActivePresentation.Slides.Count Then
lSlideEnd =
ActivePresentation.Slides.Count
End If
.Add Start:=lSlide,
End:=lSlideEnd
lSlide = lSlide + lHandoutKind
End With
'
' Set
number of copies to 1.
'
.NumberOfCopies = 1
'
.OutputType =
ppHandoutKind
'
.HandoutOrder = ppPrintHandoutVerticalFirst


'
列印顏色設定為純粹黑白

.PrintColorType = ppPrintPureBlackAndWhite
'.PrintColorType = ppPrintBlackAndWhite
'.PrintColorType = ppPrintColor



'
配合紙張調整大小
.FitToPage = msoTrue

' 投影片加框
.FrameSlides =
msoTrue


End With
'
'
立即列印出來

ActivePresentation.PrintOut

'
預覽列印；設定預覽列印無法看出講義模式設定頁碼的功能
' ActiveWindow.ViewType =
ppViewPrintPreview


Next i
End
If
'
ActivePresentation.HandoutMaster.Shapes(4).TextFrame.TextRange.Text =
""
ActivePresentation.NotesMaster.HeadersFooters.SlideNumber.Visible =
msoTrue