excel vba 根据采购台账和合同模版自动生成采购合同

 

Function findCellIndex(cellName As String)
findCellIndex = ActiveSheet.Cells.Find(cellName).Cells(1, 1).Column
End Function

Sub GenerateContract()
ThisWorkbook.Activate
Dim heTongPath, heTongMB As String
ChDir (ThisWorkbook.Path)
Dim 采购合同号的表头位置, 报价单号的表头位置, 交货期表头位置, 项目名称表头位置, ColumnIndex2, 采购金额表头位置 As Integer
采购合同号的表头位置 = findCellIndex("采购合同号")
报价单号的表头位置 = findCellIndex("报价单号")
交货期表头位置 = findCellIndex("交货期")
项目名称表头位置 = findCellIndex("项目名称")
ColumnIndex2 = findCellIndex("采购内容")
采购金额表头位置 = findCellIndex("合同金额")
heTongMB = Dir(ThisWorkbook.Path + "\采购合同范本.xlsx")
If heTongMB = "" Then
  MsgBox ("采购合同范本.xlsx不存在")
Else
heTongMB = ThisWorkbook.Path + "\采购合同范本.xlsx"
' MsgBox (Date$ + "采购合同")
On Error Resume Next
VBA.MkDir (ThisWorkbook.Path + "\" + Date$ + "采购合同") '创建文件夹，如果已经有文件夹了则继续运行
heTongPath = ThisWorkbook.Path + "\" + Date$ + "采购合同\"
' MsgBox (heTongPath)
Dim rowIndex, rowCount, columnIndex, colCount As Integer
rowCount = Selection.Rows.Count
For rowIndex = 1 To rowCount
'get file name
Dim HeTongName, 报价单号 As String
Dim HeTongBianHao As String
HeTongBianHao = Selection.Cells(rowIndex, 采购合同号的表头位置).Value
报价单号 = Selection.Cells(rowIndex, 报价单号的表头位置).Value
交货期 = Selection.Cells(rowIndex, 交货期表头位置).Value
项目名称 = Selection.Cells(rowIndex, 项目名称表头位置).Value
采购物料 = Selection.Cells(rowIndex, ColumnIndex2).Value
采购金额 = Selection.Cells(rowIndex, 采购金额表头位置).Value
HeTongName = HeTongBianHao & "_" & 采购物料 & ".xlsx"
FileCopy heTongMB, heTongPath & HeTongName
Dim HeTong As Workbook
Set HeTong = Workbooks.Open(heTongPath & HeTongName)
HeTong.Sheets(1).Cells(3, 17).Value = HeTongBianHao
HeTong.Sheets(1).Cells(4, 17).Value = Date$ '修改合同日期
HeTong.Sheets(1).Cells(12, 16).Value = 交货期
HeTong.Sheets(1).Cells(16, 2).Value = 项目名称
HeTong.Sheets(1).Cells(16, 7).Value = 采购物料
HeTong.Sheets(1).Cells(16, 14).Value = 采购金额
HeTong.Sheets(2).Cells(9, 6).Value = 报价单号  '报价单号
HeTong.Save
HeTong.Close
Next rowIndex

End If
End Sub