标签:
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
标签:
原文地址:http://www.cnblogs.com/cnpirate/p/4944987.html