求助关于vbs中从Excel中获取数据，批量替换word中的文字的问题

dyf861

求助各位大佬，本人需要将Excel的数据替换到word中，找到以下代码，结果在替换的word中显示的小数不保留2位小数且小数点前面的0不显示，请教各位大佬如何修改才能解决这个问题。代码如下

1. Const wdReplaceAll = 2
   
2. Dim arrSheet()
   
3. Dim nUsedRows, nUsedCols
   
4. Dim wordPath, exelPath
   
5. 
   
6. '将下面这一行代码的双引号中的内容替换成你的word文档地址
   
7. wordPath = ("C:\Users\Administrator\Desktop\123.doc")
   
8. '将下面这一行代码的双引号中的内容替换成你的excel文档地址
   
9. exelPath = ("C:\Users\Administrator\Desktop\123.xls")
   
10. 
    
11. Set objWord = CreateObject("Word.Application")
    
12. objWord.Visible = True
    
13. Set objDoc = objWord.Documents.Open(wordPath)
    
14. Set objSelection = objWord.Selection
    
15. 
    
16. objSelection.Find.Forward = TRUE
    
17. objSelection.Find.MatchWholeWord = TRUE
    
18. 
    
19. 
    
20. ReadExcelFile(exelPath)
    
21. 
    
22. for i=0 to nUsedRows-1
    
23.    objSelection.Find.Text = arrSheet(i,0)
    
24.    objSelection.Find.Replacement.Text = arrSheet(i,1)
    
25.    objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
    
26. next
    
27. 
    
28. Function ReadExcelFile(ByVal strFile)
    
29. 
    
30.   ' 局部变量声明
    
31.   Dim objExcel, objSheet, objCells
    
32.   Dim nTop, nLeft, nRow, nCol
    
33. 
    
34.   ' 默认返回值
    
35.   ReadExcelFile = Null
    
36. 
    
37.   ' 创建Excel对象
    
38.   On Error Resume Next
    
39.   Set objExcel = CreateObject("Excel.Application")
    
40.   If (Err.Number <> 0) Then
    
41.     Exit Function
    
42.   End If
    
43. 
    
44.   ' 不显示任何警报消息
    
45.   objExcel.DisplayAlerts = 0  
    
46. 
    
47.   ' 以只读方式打开文档
    
48.   On Error Resume Next
    
49.   Call objExcel.Workbooks.Open(strFile, False, True)
    
50.   If (Err.Number <> 0) Then
    
51.     Exit Function
    
52.   End If
    
53. 
    
54.   '读取第一页
    
55.   Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    
56. 
    
57.   ' 获取已使用的行数
    
58.   nUsedRows = objSheet.UsedRange.Rows.Count
    
59. 
    
60.   ' 获取已使用列的数量
    
61.   nUsedCols = objSheet.UsedRange.Columns.Count
    
62. 
    
63.   ' 获取包含数据的最顶行
    
64.   nTop = objSheet.UsedRange.Row
    
65. 
    
66.   ' 获取包含数据的最左侧列
    
67.   nLeft = objSheet.UsedRange.Column
    
68. 
    
69.   ' 获取用过的单元格
    
70.   Set objCells = objSheet.Cells
    
71. 
    
72.   ' 对图纸数组进行尺寸标注
    
73.   ReDim arrSheet(nUsedRows - 1, nUsedCols - 1)
    
74. 
    
75.   ' 循环遍历每一行
    
76.   For nRow = 0 To (nUsedRows - 1)
    
77.   ' 循环遍历每一列
    
78.     For nCol = 0 To (nUsedCols - 1)
    
79.   ' 将单元格值添加到工作表数组
    
80.   arrSheet(nRow, nCol) = objCells(nRow + nTop, nCol + nLeft).Value
    
81.     Next
    
82.   Next
    
83. 
    
84.   ' 关闭工作簿而不保存
    
85.   Call objExcel.ActiveWorkbook.Close(False)
    
86. 
    
87.   ' 退出Excel
    
88.   objExcel.Application.Quit
    
89. 
    
90.   ' 将工作表数据返回给调用者
    
91.   ReadExcelFile =arrSheet
    
92. 
    
93. End Function
    

复制代码

flashercs

为何不早上图,还以为只有数字!!!!!
第80行:

1. Dim varValue
   
2. varValue = objCells(nRow + nTop, nCol + nLeft).Value
   
3. If IsNumeric(varValue) Then
   
4.     arrSheet(nRow, nCol) = FormatNumber(varValue, 2, vbTrue, vbUseDefault, vbUseDefault)
   
5. Else
   
6.     arrSheet(nRow, nCol) = CStr(varValue)
   
7. End If
   

复制代码

dyf861

回复 2# flashercs


    大佬，我修改完后没有效果，求助， 原excel文件
javascript:;

    原word文件
    javascript:;

    修改完成后
    javascript:;

flashercs

回复 3# dyf861

上面已修改