ppt(x)文件合并与文字提取.pdfVIP

ppt(x)文件合并与文字提取 启动 PowerPoint 后按下 Alt+F11，打开VBA 编辑器， “插入”“用户窗体” 制作如下图所示窗体 （名称为frmMerge），绿色字体标注的部分 Label 可省去，红色字体标注的全部的 CommandButton、TextBox、ListBox、部分 Label 均需要添加 然后在窗体名称 frmMerge 上右键， “查看代码”，将以下代码粘贴进去，左键双击窗体名称 frmMerge 后，按 F5 或 Fn+F5，便可弹出执行文件合并功能的窗体。 代码： 该窗体执行合并多个 ppt(x)文件的功能，是一个无模式窗体 Option Explicit Public Force2Stop As Boolean Force2Stop 变量用来中止循环 Public i As Integer Private Sub frmMerge_Load() Force2Stop = False 初值为 False，循环可执行 End Sub 打开文件对话框 Private Sub BtnChoose_Click() Dim tF As FileDialog Set tF = Application.FileDialog(msoFileDialogOpen) tF.AllowMultiSelect = True tF.Title = 请选择要合并的 ppt(x)文件（可以多选） tF.Filters.Clear tF.Filters.Add ppt(x)文件 (*.ppt,*.pptx), *.ppt,*.pptx tF.Show If tF.SelectedItems.Count 1 Then Exit Sub For i = 1 To tF.SelectedItems.Count lstFile.AddItem tF.SelectedItems(i) Next End Sub 保存文件对话框 Private Sub BtnSave_Click() Dim tF As FileDialog Set tF = Application.FileDialog(msoFileDialogSaveAs) tF.Title = 选择合并后的 ppt(x)文件的保存位置 tF.Show If tF.SelectedItems.Count 1 Then Exit Sub txtSave.Text = tF.SelectedItems(1) End Sub “开始合并”按钮 Private Sub BtnStart_Click() 该过程执行合并功能 Dim MerPres As Presentation, OriPres As Presentation Dim lPPTCnt As Integer, slinum As Integer lPPTCnt = lstFile.ListCount 待合并的文件总数 Force2Stop = False 置为 False，使循环可执行 If lPPTCnt 2 Then MsgBox ppt(x)文件不超过一个，不需要合并！, vbOKOnly + vbInformation, 温馨提示 Exit Sub End If TotalFile.Caption = lstFile.ListCount 待合并的文件总数 If Trim(txtSave.Text) = Then MsgBox 请选择文件保存位置, vbOKOnly + vbInformation, 温馨提示 BtnSave_Click Exit Sub End If 静默方式运行,打开列表框 listbox 中的第一个文件，把后面的ppt(x)文件（复制）添加进来 Set MerPres = Application.Presentations.Open(frmMerge.lstFile.List(0), , , msoFalse) CurFile.Caption = 1 文件