|
|
Sub 可彩色可连续页码打针()
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？", "讲义打印类型", "4")
'
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("You have chosen to print " & lHandoutKind & "-up handouts, starting at page " & lStart & vbNewLine & " and slide number " & 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
End With
'
ActivePresentation.PrintOut
Next i
End If
'
ActivePresentation.HandoutMaster.Shapes(4).TextFrame.TextRange.Text = ""
ActivePresentation.NotesMaster.HeadersFooters.SlideNumber.Visible = msoTrue
end sub |
|
