批处理之家's Archiver

dyf861 发表于 2019-3-9 00:08

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

求助各位大佬,本人需要将Excel的数据替换到word中,找到以下代码,结果在替换的word中显示的小数不保留2位小数且小数点前面的0不显示,请教各位大佬如何修改才能解决这个问题。代码如下[code]Const wdReplaceAll = 2
Dim arrSheet()
Dim nUsedRows, nUsedCols
Dim wordPath, exelPath

'将下面这一行代码的双引号中的内容替换成你的word文档地址
wordPath = ("C:\Users\Administrator\Desktop\123.doc")
'将下面这一行代码的双引号中的内容替换成你的excel文档地址
exelPath = ("C:\Users\Administrator\Desktop\123.xls")

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(wordPath)
Set objSelection = objWord.Selection

objSelection.Find.Forward = TRUE
objSelection.Find.MatchWholeWord = TRUE


ReadExcelFile(exelPath)

for i=0 to nUsedRows-1
   objSelection.Find.Text = arrSheet(i,0)
   objSelection.Find.Replacement.Text = arrSheet(i,1)
   objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
next

Function ReadExcelFile(ByVal strFile)

  ' 局部变量声明
  Dim objExcel, objSheet, objCells
  Dim nTop, nLeft, nRow, nCol

  ' 默认返回值
  ReadExcelFile = Null

  ' 创建Excel对象
  On Error Resume Next
  Set objExcel = CreateObject("Excel.Application")
  If (Err.Number <> 0) Then
    Exit Function
  End If

  ' 不显示任何警报消息
  objExcel.DisplayAlerts = 0  

  ' 以只读方式打开文档
  On Error Resume Next
  Call objExcel.Workbooks.Open(strFile, False, True)
  If (Err.Number <> 0) Then
    Exit Function
  End If

  '读取第一页
  Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

  ' 获取已使用的行数
  nUsedRows = objSheet.UsedRange.Rows.Count

  ' 获取已使用列的数量
  nUsedCols = objSheet.UsedRange.Columns.Count

  ' 获取包含数据的最顶行
  nTop = objSheet.UsedRange.Row

  ' 获取包含数据的最左侧列
  nLeft = objSheet.UsedRange.Column

  ' 获取用过的单元格
  Set objCells = objSheet.Cells

  ' 对图纸数组进行尺寸标注
  ReDim arrSheet(nUsedRows - 1, nUsedCols - 1)

  ' 循环遍历每一行
  For nRow = 0 To (nUsedRows - 1)
  ' 循环遍历每一列
    For nCol = 0 To (nUsedCols - 1)
  ' 将单元格值添加到工作表数组
  arrSheet(nRow, nCol) = objCells(nRow + nTop, nCol + nLeft).Value
    Next
  Next

  ' 关闭工作簿而不保存
  Call objExcel.ActiveWorkbook.Close(False)

  ' 退出Excel
  objExcel.Application.Quit

  ' 将工作表数据返回给调用者
  ReadExcelFile =arrSheet

End Function
[/code]

flashercs 发表于 2019-3-9 11:27

[i=s] 本帖最后由 flashercs 于 2019-3-9 18:45 编辑 [/i]

为何不早上图,还以为只有数字!!!!!
第80行:[code]Dim varValue
varValue = objCells(nRow + nTop, nCol + nLeft).Value
If IsNumeric(varValue) Then
    arrSheet(nRow, nCol) = FormatNumber(varValue, 2, vbTrue, vbUseDefault, vbUseDefault)
Else
    arrSheet(nRow, nCol) = CStr(varValue)
End If
[/code]

dyf861 发表于 2019-3-9 14:52

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=218050&ptid=52214]2#[/url] [i]flashercs[/i] [/b]


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

    原word文件
    javascript:;

    修改完成后
    javascript:;

flashercs 发表于 2019-3-9 18:47

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=218064&ptid=52214]3#[/url] [i]dyf861[/i] [/b]

上面已修改

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.