三种比较常用的PPT课件打印方法

在别处看到的，感觉很不错，特地转发过来！
PPT课件的打印方法很多。但是主要要考虑两点：1.尽量节省纸张，减少打印页数；2.打印出来后要与ppt排版一致，图文清晰。
下面介绍三种比较常用的方法。

方法一： 使用PPT文件转word文档软件:ppt convert to doc 1.0绿色版。
适用：对于纯文字的ppt可以用，如果含有图片和文字，就不能用这个方法，因为它转换后会有错位。
对于纯文字的ppt用这个方法是很简便，装换速度也快。
方法二：直接把ppt打印出来。但是事先要进出一些处理，如背景色，背景图案，公式颜色，文本框。因为有的公式，图片没办法打印出来。背景色可以直接在ppt中改。所以我们用到宏指令来进行批量处理。
宏指令步骤 ：
第一步：Word：工具—→宏—→Visual Basic 编辑器 —→文件—→导入文件。宏命令文件见附件。（保存一下，以后就不用了再重复导入了）
第二步：Powerpoint：文件—→另存为—→windows图元文件。（如果PPT有背景，可先将背景模板改为白版形式）
第三步：Word：插入—→图片—→来自文件。用快捷键“Ctrl+A”全选刚才产生的所有图片，插入。
第五步：Word：工具—→宏—→宏，选择第一步中导入的那个宏，运行。
完工！

根据你要处理的内容，选择下面相应的代码，运行即可。
1、ppt里面怎么一次改变所有文字和公式的颜色
如果是所有的，那你显示为大纲模式，鼠标双击左侧的文字，全选，就可以改变文字颜色了。但插入文本框方式加入的文字不行。
2、批量更改PPT中公式的背景色
Sub 批量更改PPT中公式的背景色()
Dim aSlide As Slide, aShape As Shape
On Error Resume Next '忽略错误
    For Each aSlide In ActivePresentation.Slides '遍历幻灯片
        For Each aShape In aSlide.Shapes '遍历图层对象
            If aShape.Type = 7 Then '公式
            With aShape
                .Fill.ForeColor.RGB = RGB(255, 255, 0)
                .Fill.Visible = msoTrue
                .Fill.Solid
                .Fill.BackColor.RGB = vbYellow
                .Fill.Transparency = 0#
            End With
            End If
        Next
    Next
End Sub
3、改变文本框和其他的字体颜色但是不包括公式
Sub OED01()
Dim oShape As Shape
Dim oSlide As Slide
Dim oTxtRange As TextRange
On Error Resume Next
For Each oSlide In ActivePresentation.Slides
For Each oShape In oSlide.Shapes
Set oTxtRange = oShape.TextFrame.TextRange
If Not IsNull(oTxtRange) Then
With oTxtRange.Font
.Color.RGB = RGB(Red:=0, Green:=0, Blue:=0)
End With
End If
Next
Next
End Sub

4、使用宏实现批量修改公式的打印颜色
只能适用于公式是黄色的，背景是白色组合的修改，如果本来就是黑白组合的就起反作用了。所以要注意。
   
' VBA cannot pass Shape into a function, so global var is used
Public sh As Shape
' The macro to excute
Sub ReColor()
    Dim sld As Slide
    For Each sld In ActivePresentation.Slides
        For Each sh In sld.Shapes
            Call ReColorSH
        Next
    Next
End Sub

Sub ReColorSH()
    Dim ip As Integer     ' point to the top of the i stack
    Dim sp As Integer     ' point to the top of the shape stack
    Dim istk() As Integer ' the i stack, using dynamic array
    Dim sstk() As Shape   ' the Shape stack, using dynamic array
    Dim ssize As Integer ' the size of both stacks
    ssize = 10
    ReDim istk(ssize)
    ReDim sstk(ssize)
    ip = 0
    sp = 0
    Dim i As Integer
L2: If sh.Type = msoGroup Then
        i = 1
L1:     'pushS(sh)
        sp = sp + 1
        If sp > ssize Then
            ssize = ssize + 1
            ReDim Preserve istk(ssize)
            ReDim Preserve sstk(ssize)
        End If
        Set sstk(sp) = sh
        '----------
        'pushI (i)
        ip = ip + 1
        istk(ip) = i
        '----------
        Set sh = sh.GroupItems(i)
        GoTo L2
L3:     'popI(i)
        i = istk(ip)
        ip = ip - 1
        '----------
        'popS(sh)
        Set sh = sstk(sp)
        sp = sp - 1
        '----------
        If i < sh.GroupItems.Count Then
            i = i + 1
            GoTo L1
        End If
    ElseIf sh.Type = msoEmbeddedOLEObject Then
        If Left(sh.OLEFormat.ProgID, 8) = "Equation" Then
            sh.BlackWhiteMode = msoBlackWhiteBlack
        End If
    End If
    If ip > 0 Then GoTo L3
End Sub
在PowerPoint 2003下运行通过。（使用时只要随便新建一个宏，把它自动生成的代码全删去，粘贴上面这段代码。然后运行 ReColor 这个宏就可以了。） 对了，只有在打印的时候把模式选成黑白效果才会显现。幻灯片本身的颜色不会改变。（如果不运行这个宏,即使用黑白打印公式也是浅灰的。）
根据需要修改字体、字号、字体颜色，同时加粗、倾斜、阴影等都可自行设定，执行宏后即可。
Sub Allchange()
    Dim osld As Slide, oshp As Shape
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
           With oshp.TextFrame.TextRange.Font
                .Name = "楷体_GB2312"
                .Size = 24
                .Color.RGB = RGB(255, 0, 0)
                .Bold = msoFalse
                .Italic = msoFalse
                .Shadow = False
            End With
        Next oshp
    Next osld
End Sub
适用：直接用ppt有个缺点，就是讲义中的每张ppt之间间距太大，有的浪费空间。如果不在意的话直接这样就行。如果想充分利用空间，可以在方法二处理完颜色的基础上，按方法三进行打印。如果想省时间，方法二就行。

方法三：用宏指令把ppt转换到word里面的图片打印。可以一页word打印8页或者9页的ppt。
选择8张还是9张，再复制相应的代码，运行即可。
一页8张PPT自动排版宏命令：
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 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
 
 
一页9张PPT自动排版宏命令
Attribute VB_Name = "NewMacros"
Sub 一页9张PPT自动排版()
Attribute 一页9张PPT自动排版.VB_Description = "宏在 2008-6-16 由 欣宇 录制"
Attribute 一页9张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 = wdOrientLandscape
        .TopMargin = CentimetersToPoints(0.6)
        .BottomMargin = CentimetersToPoints(0.6)
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(0.8)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(0.5)
        .FooterDistance = CentimetersToPoints(0.9)
        .PageWidth = CentimetersToPoints(29.7)
        .PageHeight = CentimetersToPoints(21)
        .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
   
'【调整每张幻灯片的大小为高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
适用：这个方法应该算是最佳打印方法了。
 
 
 
 
最后注意几点问题：
1.上课老师的课件经常是一个章节一个章节地给。打印时，不要为了图方便，把所有章节的ppt合并成一个。
2.ppt再打印，这样的话，打印出来的公式都会错位。
3.可以把ppt复制到新的空白演示文稿，这样就可以去掉背景色和图案（比较方便）。

4.每次弄好课件要看打印预览的情况，认真看，是否有与ppt不一样的地方，主要看那些公式有没有显示出来。
5. 对于有黄颜色字体的公式要注意用宏指令修改。
6 . 对于文本框显示不出来的，可以不修改，因为打印可以出来。