设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › excel内容替换word模板中的数据,如何做?
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器，一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理，一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12下一页
返回列表 发新帖
查看: 6600|回复: 11

[已解决] excel内容替换word模板中的数据,如何做?

[复制链接]
sblisb

TA的精华主题

TA的得分主题
发表于 2013-4-11 22:05 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
本帖最后由 sblisb 于 2013-4-12 17:44 编辑

要替换的数据我已命名为数据1,数据2了,请指教!
模板只有一页,我如果有二条数据,要生成两页,如何做呢?
test.rar (12.34 KB, 下载次数: 84)
excel, 内容, 替换, word, 模板
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-4-11 22:57 | 显示全部楼层
[广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★
请测试:
  1. Private Sub CommandButton1_Click()
  2.     Dim f$, f2$, p$, arr, i&, j&, lr&
  3.     Application.ScreenUpdating = False
  4.     arr = [a1].CurrentRegion
  5.     lr = UBound(arr)
  6.     p = ThisWorkbook.Path & ""
  7.     d = Format(Date, "yyyy年mm月dd日")
  8.     f = p & "新建 Microsoft Word 文档.doc"
  9.     f2 = p & arr(2, 2) & arr(lr, 2) & ".doc"
  10.     FileCopy f, f2
  11.     With CreateObject("Word.Application")
  12.         .Documents.Open f2
  13.         .ActiveWindow.ActivePane.View.SeekView = 0 ' wdSeekMainDocument '设置位置在正文
  14.         .Selection.WholeStory '全选
  15.         .Selection.Copy '复制
  16.          For i = 1 To lr - 2 '复制页
  17.             .Selection.EndKey Unit:=6 'wdStory '光标置于文件尾
  18.             .Selection.InsertBreak Type:=7 'wdPageBreak '分页
  19.             .Selection.PasteAndFormat (0) '粘贴wdPasteDefault
  20.          Next i
  21.         For i = 2 To lr
  22.             arr(i, 1) = WorksheetFunction.Text(arr(i, 1), "[DBNum1]yyyy年m月d日")
  23.             For j = 1 To 8
  24.                 If j <> 3 Then
  25.                     .Selection.HomeKey Unit:=6
  26.                     If .Selection.Find.Execute("数据" & j) Then
  27.                         .Selection.Text = arr(i, j)
  28.                         If j = 2 Then .Selection.Font.Name = "隶书"
  29.                     End If
  30.                 End If
  31.             Next
  32.         Next
  33.         .Documents.Save
  34.         .Quit
  35.     End With
  36.     Application.ScreenUpdating = True
  37.     MsgBox "ok"
  38. End Sub

复制代码
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-4-11 22:58 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
请看附件
test.rar (19.74 KB, 下载次数: 110)
回复

举报

sblisb

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-4-12 08:59 | 显示全部楼层
[广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★
本帖最后由 sblisb 于 2013-4-12 10:49 编辑
zhaogang1960 发表于 2013-4-11 22:58
请看附件


谢谢，想在最后加一句打开生成的word文件，以备打印，如何写？

还有一个小问题，我把第一条打印状态改成空，生成文件正确有三页，可是文件名怎么是头尾的号，少了中间的082号码？应当为081082083.doc
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-4-12 11:13 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
sblisb 发表于 2013-4-12 08:59
谢谢，想在最后加一句打开生成的word文件，以备打印，如何写？

还有一个小问题，我把第一条打印状态 ...
  1. Private Sub CommandButton1_Click()
  2.     Dim f$, f2$, p$, arr, i&, j&, lr&, s$
  3.     Application.ScreenUpdating = False
  4.     arr = [a1].CurrentRegion
  5.     lr = UBound(arr)
  6.     For i = 2 To lr
  7.         s = s & arr(i, 2)
  8.     Next
  9.     p = ThisWorkbook.Path & ""
  10.     d = Format(Date, "yyyy年mm月dd日")
  11.     f = p & "新建 Microsoft Word 文档.doc"
  12.     f2 = p & s & ".doc"
  13.     FileCopy f, f2
  14.     With CreateObject("Word.Application")
  15.         .Documents.Open f2
  16.         .ActiveWindow.ActivePane.View.SeekView = 0 ' wdSeekMainDocument '设置位置在正文
  17.         .Selection.WholeStory '全选
  18.         .Selection.Copy '复制
  19.          For i = 1 To lr - 2 '复制页
  20.             .Selection.EndKey Unit:=6 'wdStory '光标置于文件尾
  21.             .Selection.InsertBreak Type:=7 'wdPageBreak '分页
  22.             .Selection.PasteAndFormat (0) '粘贴wdPasteDefault
  23.          Next i
  24.         For i = 2 To lr
  25.             arr(i, 1) = WorksheetFunction.Text(arr(i, 1), "[DBNum1]yyyy年m月d日")
  26.             For j = 1 To 8
  27.                 If j <> 3 Then
  28.                     .Selection.HomeKey Unit:=6
  29.                     If .Selection.Find.Execute("数据" & j) Then
  30.                         .Selection.Text = arr(i, j)
  31.                         If j = 2 Then .Selection.Font.Name = "隶书"
  32.                     End If
  33.                 End If
  34.             Next
  35.         Next
  36.         .Documents.Save
  37.         .Selection.HomeKey Unit:=6
  38.         .Visible = True
  39.     End With
  40.     Application.ScreenUpdating = True
  41. End Sub

复制代码
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-4-12 11:15 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
请看附件
test.rar (15.62 KB, 下载次数: 138)

评分

2

查看全部评分

回复

举报

sblisb

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-4-12 17:44 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
zhaogang1960 发表于 2013-4-12 11:15
请看附件

发现没有检查打印状态，不过这个我自己能改，谢谢了
回复

举报

dyzx

TA的精华主题

TA的得分主题
发表于 2018-10-3 09:52 | 显示全部楼层
[广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★
zhaogang1960 发表于 2013-4-12 11:15
请看附件

zhaogang1960老师：如果还要输送到打印机打印，应该加一条什么代码？请指教，多谢。
回复

举报

dyzx

TA的精华主题

TA的得分主题
发表于 2018-10-3 09:53 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
sblisb 发表于 2013-4-12 17:44
发现没有检查打印状态，不过这个我自己能改，谢谢了

sblisb老师：如果还要输送到打印机打印，应该加一条什么代码？请指教，多谢。
回复

举报

xyxcc177

TA的精华主题

TA的得分主题
发表于 2018-10-3 10:19 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
ThisDocument.PrintOut
回复

举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-16 10:53 , Processed in 0.026099 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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