Board logo

标题: [问题求助] 求助关于vbs中从Excel中获取数据,批量替换word中的文字的问题 [打印本页]

作者: dyf861    时间: 2019-3-9 00:08     标题: 求助关于vbs中从Excel中获取数据,批量替换word中的文字的问题

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

作者: flashercs    时间: 2019-3-9 11:27

本帖最后由 flashercs 于 2019-3-9 18:45 编辑

为何不早上图,还以为只有数字!!!!!
第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    时间: 2019-3-9 14:52

回复 2# flashercs


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

    原word文件
    javascript:;

    修改完成后
    javascript:;
作者: flashercs    时间: 2019-3-9 18:47

回复 3# dyf861

上面已修改




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2