如何在excel中新建word文档，并将excel中某几列的数据写入word文档。

felixiiiii

各位老师，初学excel编程，现在单位有个活，请各位老师帮帮忙，我自己鼓捣了好几天也没弄成。
我现在有一张库存数据表，需要定期将出库的数量不等的物料导入到新建的word中保存。因为每次出库的物料种类数量不一，例如：上周出库10种药材，每种100克—500克不等，这周出库15种，每种也是克数不一。所以如果使用word模板的那种方式，会在生成的word文档中出现替换不掉的【数据09】，【数据10】等字样。所以我希望能够用vba编码实现直接把excel表中的某几列的数据写入新建的word文档，而不是通用的替换对应模板里的【数据01】【数据02】。
附件表格和生成的word文档效果如下：（在线等呀，挺着急的这活儿。拜托拜托！！） test.rar (17.23 KB, 下载次数: 7)

2017-11-13 20:16 上传

点击文件名下载附件

小花鹿

串成一个字符串再替换不就行了............................................................................

182197315

Sub 生成Word文件()
Dim wdapp As new Word.Application
Dim arr, brr(1 To 3), myPath$, i%, k%, sr$
myPath = ThisWorkbook.Path & "\"
arr = Range("A1").CurrentRegion
brr(1) = arr(1, 1)
'brr(2) = WorksheetFunction.Now()
brr(2) = "2017"
FileCopy myPath & "XX方剂 （模板）.docx", myPath & arr(1, 1) & ".docx"
For i = 3 To UBound(arr)
    sr = sr & arr(i, 2) & arr(i, 8) & arr(i, 9) & "，"
Next
brr(3) = Left(sr, Len(sr) - 1)
With wdapp
    .Documents.Open myPath & arr(1, 1) & ".docx"
    .Visible = True
    For k = 1 To 3
        .Selection.HomeKey Unit:=wdStory    '光标置于文件首
        If .Selection.Find.Execute("数据" & k) Then '查找到指定字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
            .Selection.Text = brr(k) '替换字符串
        End If
    Next
End With
wdapp.Quit
End Sub

duquancai

Sub WordVBA()
    Dim conn As Object, pf$, Sql$, arr, doc As Document, sr$
    pf = ThisDocument.Path & "\库存数据.xlsx"
    Sql = "select 名称,数量,单位 from [" & pf & "].[数据$a2:n] where 编号 is not null"
    Set conn = CreateObject("adodb.connection")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=EXCEL 12.0;data source=" & pf
    arr = conn.Execute(Sql).GetRows
    For i = 0 To UBound(arr, 2)
        sr = sr & "，" & arr(0, i) & " " & arr(1, i) & arr(2, i)
    Next
    Set doc = Documents.Add(Visible:=fase)
    With doc.Content
        .InsertAfter "XX方剂" & vbCr & "日期：" & Date & vbCr & "成分：" & Mid(sr, 2)
    End With
    doc.SaveAs ThisDocument.Path & "\XX方剂1.docx"
    doc.Close
    conn.Close
    Set conn = Nothing
End Sub

felixiiiii

duquancai 发表于 2017-11-13 23:40
Sub WordVBA()
    Dim conn As Object, pf$, Sql$, arr, doc As Document, sr$
    pf = ThisDocument.P ...

我复制到excel中运行，提示运行时错误“424”，要求对象，这是什么情况？
大神，能否把代码放到我上传的附件中

felixiiiii

182197315 发表于 2017-11-13 22:22
Sub 生成Word文件()
Dim wdapp As new Word.Application
Dim arr, brr(1 To 3), myPath$, i%, k%, sr$

运行后提示文件未找到，逐行运行发现，运行到FileCopy myPath & "XX方剂（模板）.docx", myPath & arr(1, 1) & ".docx"这句后跳出提示“文件未找到”