ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 108|回复: 5

[求助] 如何在excel中新建word文档,并将excel中某几列的数据写入word文档。

[复制链接]

TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

发表于 2017-11-13 20:24 | 显示全部楼层
串成一个字符串再替换不就行了............................................................................

TA的精华主题

TA的得分主题

发表于 2017-11-13 22:22 | 显示全部楼层
本帖最后由 182197315 于 2017-11-13 22:46 编辑

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

TA的精华主题

TA的得分主题

发表于 2017-11-13 23:40 | 显示全部楼层
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

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-11-14 15:19 | 显示全部楼层
duquancai 发表于 2017-11-13 23:40
Sub WordVBA()
    Dim conn As Object, pf$, Sql$, arr, doc As Document, sr$
    pf = ThisDocument.P ...

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-11-14 15:31 | 显示全部楼层
本帖最后由 felixiiiii 于 2017-11-14 15:36 编辑
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"这句后跳出提示“文件未找到”
您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

手机版|关于我们|联系我们|ExcelHome   

GMT+8, 2017-11-23 09:48 , Processed in 0.156577 second(s), 22 queries , Gzip On, MemCache On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表