zoukankan      html  css  js  c++  java
  • 20161226xlVBA演示文稿替换文字另存pdf

    Const ModelText As String = "机构名称"
    Const ModelName As String = "测试文件.pptx"
    
    Sub NextSeven_CodeFrame()
        '应用程序设置
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.Calculation = xlCalculationManual
        '错误处理
        On Error GoTo ErrHandler
        '计时器
        Dim StartTime, UsedTime As Variant
        StartTime = VBA.Timer
    
        '变量声明
        Dim Wb As Workbook
        Dim Sht As Worksheet
        Dim Rng As Range
        Dim Arr As Variant
        Dim EndRow As Long
    
        Dim pApp As Object
        Dim Pre As Object
        'Dim pApp As PowerPoint.Application
        'Dim pre As PowerPoint.Presentation
    
        Dim FindStr As String
        Dim ReplaceStr As String
        Dim FilePath As String
        Dim FolderPath As String
        Dim tmp As String
    
        Dim FileName As String
        FileName = Left(ModelName, InStrRev(ModelName, ".") - 1)
        '实例化对象
        Set Wb = Application.ThisWorkbook
        Set Sht = Wb.Worksheets(1)
        FolderPath = Wb.Path & ""
        'Set pApp = New PowerPoint.Application
        Set pApp = CreateObject("PowerPoint.Application")
        Debug.Print FolderPath & ModelName
        Set Pre = pApp.Presentations.Open(FolderPath & ModelName)
        With Sht
            EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
            Set Rng = .Range("A1:Z" & EndRow)
            Arr = Rng.Value
            For i = LBound(Arr) To UBound(Arr)
                If i = 1 Then
                    FindStr = ModelText
                    ReplaceStr = Arr(i, 1)
                    FilePath = FolderPath & FileName & "_予" & Arr(i, 1) & ".pdf"
                    ReplaceAndPublish Pre, FilePath, FindStr, ReplaceStr
                Else
                    FindStr = Arr(i - 1, 1)
                    ReplaceStr = Arr(i, 1)
                    FilePath = FolderPath & FileName & "_予" & Arr(i, 1) & ".pdf"
                    ReplaceAndPublish Pre, FilePath, FindStr, ReplaceStr
                End If
            Next i
        End With
        '运行耗时
        UsedTime = VBA.Timer - StartTime
        'MsgBox "本次运行耗时:" & Format(UsedTime, "0.0000000秒")
    ErrorExit:        '错误处理结束,开始环境清理
        Pre.Close
        Set Pre = Nothing
        pApp.Quit
        Set pApp = Nothing
        Set Wb = Nothing
        Set Sht = Nothing
        Set Rng = Nothing
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.Calculation = xlCalculationAutomatic
        Exit Sub
    ErrHandler:
        If Err.Number <> 0 Then
            MsgBox Err.Description & "!", vbCritical, "错误提示!"
            'Debug.Print Err.Description
            Err.Clear
            Resume ErrorExit
        End If
    End Sub
    Private Sub ReplaceAndPublish(ByVal Pre As Object, ByVal FilePath As String, ByVal FindText As String, ByVal ReplaceText As String)
        Dim sld As PowerPoint.Slide
        Dim shp As PowerPoint.Shape
        Dim Txt As String
        For Each sld In Pre.Slides
            For Each shp In sld.Shapes
                If shp.HasTextFrame = msoTrue Then
                    If shp.TextFrame.HasText Then
                        Txt = shp.TextFrame.TextRange.Text
                        If InStr(1, Txt, FindText) > 0 Then
                            shp.TextFrame.TextRange.Text = Replace(Txt, FindText, ReplaceText)
                            Exit For
                        End If
                    End If
                End If
            Next
        Next
        Pre.SaveAs FilePath, ppSaveAsPDF
    End Sub
    

      

  • 相关阅读:
    201771030120-王嫄 实验三 结对项目—《西北师范大学疫情防控信息系统》项目报告
    201771030120-王嫄 实验二 个人项目—《西北师范大学学生疫情上报系统》项目报告
    201771030120-王嫄 实验一 软件工程准备 <课程学习目的思考>
    ETH充提币API接口中文文档
    开放API接口 USDT快捷接入充提教程
    比特币BTC支付API接口中文文档
    ERC20充提币API接口文档
    如何调用比特币钱包RPC API实现充值、转账、支付?
    .NET对接交易所钱包教程
    Java 对接交易所钱包解决方案
  • 原文地址:https://www.cnblogs.com/nextseven/p/7133841.html
Copyright © 2011-2022 走看看