Intro

前几天去拷英语的课件（例如 这个帖子 里的），之吓人，20MB一个。于是花半个小时写了个小工具，专gate删除ppt里的嵌入声音。测试了下，20MB的ppt压缩成了613KB，貌似效果不错哈～

使用说明

拖放文件到 SoundButtonRipper.vbs 上，该vbs脚本会自动保存原ppt为 文件名_ripped.ppt

源码

Copy code

'======================================
'
'SoundButtonRipper.vbs V1.0
'
'Author:   est
'Email:     [email]electroniXtar@Gmail.com[/email]
'Modified:   14:36 2007/7/9
'
'======================================

'全局变量
Dim PptApp, PptPre
Set PptApp=CreateObject("powerpoint.application")
PptApp.Visible=True '必须为True否则出错
PptApp.WindowState=1 '最小化以免影响视线
WScript.Sleep 1000

Function RipSndBtns(strFilePath)
Set PptPre=PptApp.Presentations.Open(strFilePath) '必须是完整路径，出错就用 8.3 路径
'Set PptPre=PptApp.ActivePresentation '测试用
For Each PptSlide In PptPre.Slides
  For Each PptShape In PptSlide.Shapes
    'WScript.Echo PptSlide.SlideIndex & "   " & PptShape.Type & "   " & PptShape.Id & "   " & PptShape.AutoShapeType 测试用
    If PptShape.Type=1 And PptShape.AutoShapeType=135 Then
          PptShape.Delete
    End If
  Next
Next
'分析ppt的路径，另存为 原文件名_ripped.ppt
strPathPart=Split(strFilePath,"\")
strFileName=strPathPart(UBound(strPathPart))
lenFileName=Len(strFileName)
Call PptPre.Saveas(Left(strFilePath,Len(strFilepath)-lenFileName) & Left(strfilename,lenFileName-4)&"_ripped.ppt")
Call PptPre.Close()
End Function

Call RipSndBtns(WScript.Arguments(0))
PptApp.Quit

下载

Quote:

引用第2楼甫懿于2007-07-11 13:04发表的:
有些ppt里面的图片很大，不少老师直接把bmp的拖进去。
我记得有一个软件专gate解决这个问题。

我觉得这个才是关键

貌似pp07已经可以解决这个问题了