• 【中国梦·大国工匠篇】鸡蛋上钻孔显真功 潜心坚守一线练就绝活儿 2019-06-11
  • 【理上网来·喜迎十九大】塞尔维亚驻华大使:中国的发展是其他国家望尘莫及的 2019-06-10
  • 六大工程培育发展新动能 2019-06-10
  • 为推动上合组织发展提供中国智慧、中国方案 2019-05-29
  • 覆盖31亿人口!一图告诉你上合组织有多牛 2019-05-28
  • 德味手表了解一下 徕卡推出L1,L2机械表德味手表徕卡推出L1-手机行情 2019-05-28
  • 西部网(陕西新闻网)www.cnwest.com 2019-05-27
  • 穿越千年 感悟周公 2019-05-27
  • 2017年度一级建造师考试成绩已发布 2019-05-27
  • 【大考2018】2018高考首日众生相(组图) 2019-05-27
  • 浙江舟山定海区一国企非党管理人员涉嫌受贿被查 2019-05-23
  • 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28
  • 批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
    [批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
    返回列表 发帖

    广东11选5总和大小:[问题求助] 求助vbs中从Excel中获取数据,批量替换word中的文字

    求助各位大佬,本人需要将Excel的数据替换到word中,找到以下代码,结果打开vbs后出现脚本行错误字符代码源,请教各位大佬如何修改才能解决这个问题。代码如下
     广东十一选五计划软件 www.qe-ar.com 
    1. Const wdReplaceAll = 2
    2. Dim arrSheet()
    3. Dim nUsedRows, nUsedCols
    4. Dim wordPath, exelPath
    5. '将下面这一行代码的双引号中的内容替换成你的word文档地址
    6. wordPath = ("C:\Users\Administrator\Desktop\1.doc")
    7. '将下面这一行代码的双引号中的内容替换成你的excel文档地址
    8. exelPath = ("C:\Users\Administrator\Desktop\1.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.   ' Local variable declarations
    23.   Dim objExcel, objSheet, objCells
    24.   Dim nTop, nLeft, nRow, nCol
    25.   ' Default return value
    26.   ReadExcelFile = Null
    27.   ' Create the Excel object
    28.   On Error Resume Next
    29.   Set objExcel = CreateObject("Excel.Application")
    30.   If (Err.Number <> 0) Then
    31.     Exit Function
    32.   End If
    33.   ' Don't display any alert messages
    34.   objExcel.DisplayAlerts = 0  
    35.   ' Open the document as read-only
    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.   ' If you wanted to read all sheets, you could call
    42.   ' objExcel.Worksheets.Count to get the number of sheets
    43.   ' and the loop through each one. But in this example, we
    44.   ' will just read the first sheet.
    45.   Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    46.   ' Get the number of used rows
    47.   nUsedRows = objSheet.UsedRange.Rows.Count
    48.   ' Get the number of used columns
    49.   nUsedCols = objSheet.UsedRange.Columns.Count
    50.   ' Get the topmost row that has data
    51.   nTop = objSheet.UsedRange.Row
    52.   ' Get leftmost column that has data
    53.   nLeft = objSheet.UsedRange.Column
    54.   ' Get the used cells
    55.   Set objCells = objSheet.Cells
    56.   ' Dimension the sheet array
    57.   ReDim arrSheet(nUsedRows - 1, nUsedCols - 1)
    58.   ' Loop through each row
    59.   For nRow = 0 To (nUsedRows - 1)
    60.     ' Loop through each column
    61.     For nCol = 0 To (nUsedCols - 1)
    62.   ' Add the cell value to the sheet array
    63.   Dim varValue
    64. varValue = objCells(nRow + nTop, nCol + nLeft).Value
    65. If IsNumeric(varValue) Then
    66.     arrSheet(nRow, nCol) = FormatNumber(varValue, 2, vbTrue, vbUseDefault, vbUseDefault)
    67. Else
    68.     arrSheet(nRow, nCol) = CStr(varValue)
    69. End If
    70.     Next
    71.   Next
    72.   ' Close the workbook without saving
    73.   Call objExcel.ActiveWorkbook.Close(False)
    74.   ' Quit Excel
    75.   objExcel.Application.Quit
    76.   ' Return the sheet data to the caller
    77.   ReadExcelFile = arrSheet
    78. End Function
    复制代码
    附件: 您需要登录才可以下载或查看附件。没有帐号?注册
    阿瑟东

    返回列表
  • 【中国梦·大国工匠篇】鸡蛋上钻孔显真功 潜心坚守一线练就绝活儿 2019-06-11
  • 【理上网来·喜迎十九大】塞尔维亚驻华大使:中国的发展是其他国家望尘莫及的 2019-06-10
  • 六大工程培育发展新动能 2019-06-10
  • 为推动上合组织发展提供中国智慧、中国方案 2019-05-29
  • 覆盖31亿人口!一图告诉你上合组织有多牛 2019-05-28
  • 德味手表了解一下 徕卡推出L1,L2机械表德味手表徕卡推出L1-手机行情 2019-05-28
  • 西部网(陕西新闻网)www.cnwest.com 2019-05-27
  • 穿越千年 感悟周公 2019-05-27
  • 2017年度一级建造师考试成绩已发布 2019-05-27
  • 【大考2018】2018高考首日众生相(组图) 2019-05-27
  • 浙江舟山定海区一国企非党管理人员涉嫌受贿被查 2019-05-23
  • 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28