求助vbs中从Excel中获取数据,批量替换word中的文字
求助各位大佬,本人需要将Excel的数据替换到word中,找到以下代码,结果打开vbs后出现脚本行错误字符代码源,请教各位大佬如何修改才能解决这个问题。代码如下[code]Const wdReplaceAll = 2Dim arrSheet()
Dim nUsedRows, nUsedCols
Dim wordPath, exelPath
'将下面这一行代码的双引号中的内容替换成你的word文档地址
wordPath = ("C:\Users\Administrator\Desktop\1.doc")
'将下面这一行代码的双引号中的内容替换成你的excel文档地址
exelPath = ("C:\Users\Administrator\Desktop\1.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)
' Local variable declarations
Dim objExcel, objSheet, objCells
Dim nTop, nLeft, nRow, nCol
' Default return value
ReadExcelFile = Null
' Create the Excel object
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
Exit Function
End If
' Don't display any alert messages
objExcel.DisplayAlerts = 0
' Open the document as read-only
On Error Resume Next
Call objExcel.Workbooks.Open(strFile, False, True)
If (Err.Number <> 0) Then
Exit Function
End If
' If you wanted to read all sheets, you could call
' objExcel.Worksheets.Count to get the number of sheets
' and the loop through each one. But in this example, we
' will just read the first sheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
' Get the number of used rows
nUsedRows = objSheet.UsedRange.Rows.Count
' Get the number of used columns
nUsedCols = objSheet.UsedRange.Columns.Count
' Get the topmost row that has data
nTop = objSheet.UsedRange.Row
' Get leftmost column that has data
nLeft = objSheet.UsedRange.Column
' Get the used cells
Set objCells = objSheet.Cells
' Dimension the sheet array
ReDim arrSheet(nUsedRows - 1, nUsedCols - 1)
' Loop through each row
For nRow = 0 To (nUsedRows - 1)
' Loop through each column
For nCol = 0 To (nUsedCols - 1)
' Add the cell value to the sheet array
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
Next
Next
' Close the workbook without saving
Call objExcel.ActiveWorkbook.Close(False)
' Quit Excel
objExcel.Application.Quit
' Return the sheet data to the caller
ReadExcelFile = arrSheet
End Function[/code]
页:
[1]