ppt一页9张最佳打印法，下面是代码
Attribute VB_Name = "NewMacros"
Sub PPT最优打印自动排版()
Attribute PPT最优打印自动排版.VB_Description = "宏在 2008-6-16 由 欣宇 录制"
Attribute PPT最优打印自动排版.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
'
'【调整页边距及页眉页脚距，适用于A4纸】
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(1.6)
.BottomMargin = CentimetersToPoints(0.9)
.LeftMargin = CentimetersToPoints(1.4)
.RightMargin = CentimetersToPoints(1)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(0.5)
.FooterDistance = CentimetersToPoints(0.9)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
.LayoutMode = wdLayoutModeLineGrid
End With
'【加页码，页脚居中处】
Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
wdAlignPageNumberCenter, FirstPage:=True
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
If ActiveWindow.Panes.Count = 2 Then
ActiveWindow.Panes(2).Close
End If
ActiveWindow.View.SplitSpecial = wdPaneCurrentPageHeader
Else
ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
'【调整每张幻灯片的大小为高184宽262，也许还有更佳的值，可自己尝试】
Dim i As Integer
For i = 1 To ActiveDocument.InlineShapes.Count
ActiveDocument.InlineShapes(i).Height = 184
ActiveDocument.InlineShapes(i).Width = 262
Next i
'【给每张幻灯片加边框，感觉没有边框很难看】
Selection.HomeKey Unit:=wdStory
Dim j As Integer
For j = 1 To ActiveDocument.InlineShapes.Count
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
With Selection.InlineShapes(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Next j
End Sub
