office快速制作贺报方法

r囧r小猫 2022-09-04 07:51 10阅读 0赞

## 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

# 文件链接 #

[快速贺报工具下载][Link 1]

[Link 1]: https://download.csdn.net/download/weixin_44055664/21043435?spm=1001.2014.3001.5503