首页| 论坛| 消息
主题:【原创】PPT最佳打印法(8张/页法、9张/页法)
回帖:此方法所用宏命令为纯属自己突发灵感加幸运。一页8张ppt的代码如下,贴出来供高手讨论(9张的就是改了横排,去掉页码):(什么是宏)
Attribute VB_Name = "NewMacros"
Sub 一页8张PPT自动排版()
Attribute 一页8张PPT自动排版.VB_Description = "宏在 2008-6-16 由 欣宇 录制"
Attribute 一页8张PPT自动排版.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
'
'制作:啄木论坛(www.zhuomu.cn) 欣宇 版权所有
'

'【调整页边距及页眉页脚距,适用于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
下一页 (1/3)
下一楼›:做出来了 老大忒BT了

查看全部回帖(72)
«返回主帖