码迷,mamicode.com
首页 > 其他好文 > 详细

根据Excel的内容和word模板生成对应的word文档

时间:2015-11-07 15:56:58      阅读:269      评论:0      收藏:0      [点我收藏+]

标签:

Sub setname()
    Dim I As Integer
    Dim pspname As String
    Dim pspnumber As String
    Dim path As String
    Dim srcPath As String
    Dim srcPath2 As String
    
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim wordArange As Object
    Dim wordSelection As Object
    Dim ReplaceSign As Boolean
    
    Dim Search1 As String
    Dim Search2 As String
    Dim docPrefix As String
    Dim docSuffix As String
    Dim rangSize As Integer
        
    docPrefix = "-PSP"
    docSuffix = "采购规格书.doc"
    Search1 = "电线"
    Search2 = "6000397-PSP"
    rangSize = 200
    
    docPrefix = "-TST"
    docSuffix = "入厂检验规格书.doc"
    Search1 = "高压电源"
    Search2 = "6000391-TST"
    rangSize = 1100

    For I = 4 To 5
        srcPath = "C:\cygwin\tmp\BOM\tst.doc"
        path = "D:\bom\" & ActiveSheet.Cells(I, 3) & "-" & ActiveSheet.Cells(I, 4)
        srcPath2 = path & "\aa.doc"
        pspname = path & "\" & ActiveSheet.Cells(I, 3) & docPrefix & " " & ActiveSheet.Cells(I, 4) & docSuffix
        pspnumber = ActiveSheet.Cells(I, 3) & docPrefix
        MkDir (path)
        FileCopy srcPath, srcPath2
        Name srcPath2 As pspname
      
        
        Set wordApp = CreateObject("Word.Application")                  建立WORD实例
        wordApp.Visible = False                                         屏蔽WORD实例窗体
        Set wordDoc = wordApp.Documents.Open(pspname)                   打开文件并赋予文件实例
        Set wordSelection = wordApp.Selection                           定位文件实例
        Set wordArange = wordApp.ActiveDocument.Range(0, rangSize)      指定文件编辑位置
        wordArange.Select                                               激活编辑位置
        
        Do
            ReplaceSign = wordArange.Find.Execute(Search1, True, , , , , wdReplaceAll, wdFindContinue, , ActiveSheet.Cells(I, 4), True)
        Loop Until ReplaceSign = False
                
        
        Dim rngStory As Object
        Dim lngJunk As Long
        For Each rngStory In wordDoc.StoryRanges
          Do
            ReplaceSign = rngStory.Find.Execute(Search2, True, , , , , wdReplaceAll, wdFindContinue, , pspnumber, True)
            Set rngStory = rngStory.NextStoryRange
          Loop Until rngStory Is Nothing
        Next
        
        
        wordDoc.Save
        wordDoc.Close True
        wordApp.Quit
    Next I
End Sub

 

根据Excel的内容和word模板生成对应的word文档

标签:

原文地址:http://www.cnblogs.com/cnpirate/p/4944987.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!