在BOM中记录中有物料编码,物料名称,物料规格等,而且依据BOM已经生成了一些的文件,如采购规格书,这个时候需要生成相应的检验规格书模板,可以使用下面的VBA代码,具体代码如下:
Function IsFileExists(ByVal strFileName As String) As Boolean
If Dir(strFileName, ) <> Empty Then
IsFileExists = True
Else
IsFileExists = False
End If
End Function Sub setname()
Dim I As Integer
Dim pspname As String
Dim pspnumber As String
Dim tstname As String
Dim tstnumber As String
Dim path As String
Dim srcPath As String
Dim srcPath2 As String
Dim headName As String
Dim headName2 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 = "-"
docSuffix = "入场检验报告.doc"
Search1 = "高压电源"
Search2 = "6000000-TST"
'Search1 = "AC-DC开关电源"
'Search2 = "6000412-TST"
rangSize = Dim myItem
'myItem = Array(14, 16, 17, 18, 22, 23, 24, 26, 27, 31, 32, 33, 34, 35, 36, 48, 50, 55, 56, 62, 63, 64, 65, 66, 67, 68, 69, 71, 73, 77, 79, 102, 114, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 172, 173, 174, 175, 176, 177, 179, 180, 181)
For I = To
srcPath = "C:\cygwin\tmp\BOM\pqc.doc"
If ActiveSheet.Cells(I, ) = "" Then
headName2 = ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, )
headName = headName2 & docSuffix
headName3 = ActiveSheet.Cells(I, )
Else
headName2 = ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, ) & "-" & ActiveSheet.Cells(I, )
headName = headName2 & docSuffix
headName3 = ActiveSheet.Cells(I, ) & "(" & ActiveSheet.Cells(I, ) & ")"
End If
headName = Replace(headName, "/", "-")
path = "D:\bom\"
srcPath2 = path & "\aa.doc"
'pspname = path & "\" & ActiveSheet.Cells(I, 3) & docPrefix & ActiveSheet.Cells(I, 4) & docSuffix
pspname = "D:\bom\" & ActiveSheet.Cells(I, ) & "-INS-V1.0.doc"
tstname = "D:\bom\" & headName2 & "过程检验报告.doc"
tstnumber = ActiveSheet.Cells(I, ) & "-TST" If IsFileExists(pspname) = True Then
FileCopy srcPath, srcPath2
Name srcPath2 As tstname Set wordApp = CreateObject("Word.Application") '建立WORD实例
wordApp.Visible = False '屏蔽WORD实例窗体
Set wordDoc = wordApp.Documents.Open(tstname) '打开文件并赋予文件实例
Set wordSelection = wordApp.Selection '定位文件实例
Set wordArange = wordApp.ActiveDocument.Range(, rangSize) '指定文件编辑位置
wordArange.Select '激活编辑位置 Do
ReplaceSign = wordArange.Find.Execute("XXX", True, , , , , wdReplaceAll, wdFindContinue, , headName2, True)
Loop Until ReplaceSign = False 'For Each rngStory In wordDoc.StoryRanges
' Do
' ReplaceSign = rngStory.Find.Execute(Search2, True, , , , , wdReplaceAll, wdFindContinue, , tstnumber, True)
' Set rngStory = rngStory.NextStoryRange
' Loop Until rngStory Is Nothing
'Next wordDoc.Save
wordDoc.Close True
wordApp.Quit
End If
Next I End Sub