Excel数据批量导入Word

Sub main()
Dim ar_source As Variant
Dim ar_excel_4_个人客户支付委托书(1 To 8) As Variant
With Sheets("Sheet1")
ar_source = .Range("a1").CurrentRegion
ar_excel_4_个人客户支付委托书(1) = ar_source(2, 3) '借款人名称
ar_excel_4_个人客户支付委托书(2) = ar_source(11, 3) '合同编号
ar_excel_4_个人客户支付委托书(3) = Format(ar_source(7, 3), "0.00") '贷款金额小写
ar_excel_4_个人客户支付委托书(4) = AmountOfChinese(ar_source(7, 3)) '贷款金额大写
ar_excel_4_个人客户支付委托书(5) = ar_source(8, 3) '受托支付名称

ar_excel_4_个人客户支付委托书(6) = ar_source(8, 3) '受托支付名称
ar_excel_4_个人客户支付委托书(7) = ar_source(9, 3) '受托支付开户行
ar_excel_4_个人客户支付委托书(8) = ar_source(10, 3) '受托支付账号

Call 个人客户支付委托书(ar_excel_4_个人客户支付委托书)
End With
'MsgBox "OK"
End Sub
Private Sub 个人客户支付委托书(sourceArr)
' Sub makeLaoDongHeTong()
Dim wordObj As New Word.Application, currentPath$
Dim exportFolderName$, exportPathFolderName$, i, j, Str1, Str2

currentPath = ThisWorkbook.path
Result_Path = ThisWorkbook.path & "\结果"
' For i = 1 To UBound(sourceArr)
exportFolderName = "附件--个人客户支付委托书"
FileCopy currentPath & "\附件--个人客户支付委托书(模板).doc", Result_Path & "\" & exportFolderName & "(" & sourceArr(1) & ").doc"
exportPathFolderName = currentPath & "\" & exportFolderName & "(" & sourceArr(1) & ").doc"
killLaoDongHeTong (exportPathFolderName)
FileCopy currentPath & "\附件--个人客户支付委托书(模板).doc", Result_Path & "\" & exportFolderName & "(" & sourceArr(1) & ").doc"
exportPathFolderName = Result_Path & "\" & exportFolderName & "(" & sourceArr(1) & ").doc"
With wordObj
.Documents.Open exportPathFolderName
.Visible = False
For j = 1 To UBound(sourceArr) '填写文字数据
Str1 = "data" & Format(j, "000")
Str2 = sourceArr(j)
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Font.Color = wdColorAutomatic '字符为自动颜色
.Selection.Text = Str2 '替换字符串
End If
Next j
End With
wordObj.Documents.Save
wordObj.Quit
Set wordObj = Nothing
' Next
End Sub
Private Sub killLaoDongHeTong(path)
If Dir(path) <> "" Then Kill path
End Sub

Private Function AmountOfChinese(AmountSmall) As String
Dim RMBs As String
If AmountSmall = "" Or Not IsNumeric(AmountSmall) Then 大写 = "": Exit Function '如果参数为空或者非数值则返回空白
If AmountSmall = 0 Then 大写 = "零元整": Exit Function '如果参数为0则返回“零元整”
'将数值转换成中文大写，并将点替换成“元”，将负号替换成“负”
RMBs = Replace(Replace(Application.Text(Round(AmountSmall, 2), "[DBnum2]"), ".", "元"), "-", "负")
'加入角与分，同时将最后的“零”替换成“元整”
RMBs = IIf(Left(Right(RMBs, 3), 1) = "元", Left(RMBs, Len(RMBs) - 1) & "角" & Right(RMBs, 1) & "分", IIf(Left(Right(RMBs, 2), 1) = "元", bmbs & "角", IIf(RMBs = "零", "", RMBs & "元整")))
'将“零元”和“零角”替换成空
RMBs = Replace(Replace(RMBs, "零元", ""), "零角", "")
AmountOfChinese = RMBs
End Function