office快速制作贺报方法

office/wps快速制作贺报方法

使用背景

在保险、地产、中介等行业，经常需要制作贺报，且每次制作都是批量的填入指标达成情况等文字信息，制作过程繁琐复杂，故而制作快速贺报制作工具，使用VBA编写，能适合任何安装有office/wps的个人电脑。

视频演示

快速贺报制作

代码部分

Sub 贺报生成()
    
    Dim weizhi As String
    Dim idx As Integer
    Dim wb1 As String, wb2 As String, wb3 As String
    
   Path = ActivePresentation.Path
  
  weizhi = Path & "\贺报一键生成贺报数据.xlsx"
    
    wb1 = "文本1"
    wb2 = "文本2"
    wb3 = "文本3"
    wb4 = "文本4"
    Dim MyexcelApp As New Excel.Application
    Dim MyexcelBook As New Excel.Workbook
    Dim MyexcelSheet As New Excel.Worksheet
    Pathstr = weizhi
    Set MyexcelBook = MyexcelApp.Workbooks.Open(Pathstr)
    Set MyexcelSheet = MyexcelBook.Worksheets(1)
    MyexcelSheet.Activate
    Dim i As Integer
    
        Dim oPPT As Presentation
        Dim oSlide As Slide
        '当前ppt演示文稿
        Set oPPT = PowerPoint.ActivePresentation
                With oPPT
            '第一个幻灯片
             Set oSlide = .Slides(1)
            '复制到剪贴板
            oSlide.Copy



        End With
    For i = 1 To 1000

            '粘贴使其成为第2个幻灯片
            oPPT.Slides.Paste (i + 1)
        
        ActivePresentation.Slides(i + 1).Shapes(wb1).TextFrame.TextRange.Text = MyexcelSheet.Cells(i + 1, 1).Value '地区
        ActivePresentation.Slides(i + 1).Shapes(wb2).TextFrame.TextRange.Text = MyexcelSheet.Cells(i + 1, 2).Value '地区
       
    
        If MyexcelSheet.Cells(i + 2, 1).Value = "" Then

    MyexcelBook.Close

    
    Set MyexcelApp = Nothing
    Set MyexcelBook = Nothing
    Set MyexcelSheet = Nothing
            Exit Sub
        End If
    Next i
    
    MyexcelApp.Workbooks.Close
    MyexcelBook.Close
    MyexcelApp.Close
    
    Set MyexcelApp = Nothing
    Set MyexcelBook = Nothing
    Set MyexcelSheet = Nothing
End Sub

文件链接

快速贺报工具下载