ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: tthunter

如何让WORD中的数值自动填入指定的EXCEL文件中的指定位置?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-7-26 07:20 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
以下是引用tthunter在2005-7-25 22:50:30的发言:

其实,或许换个角度来看看会更简单,能不能所有的一切都在EXCEL中进行,只是填写完资金审批表后要生成一份当时填写的表格文件,以备查询。

通常情况下,使用EXCEL作为记录的数据源,你的所有数据处理应该在EXCEL中完成,然后由EXCEL向WORD中输出数据即生成表格文件,如果你的数据源设计合理的话,使用邮件合并即可解决。

由于楼主未确定以何种方式进行,我的解决方法,暂时先搁一下。

EXCEL到WORD,还是WORD到EXCEL?

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-7-26 12:07 | 显示全部楼层
如果可以的话,当然是WORD到EXCEL,谢谢!

TA的精华主题

TA的得分主题

发表于 2005-7-26 20:34 | 显示全部楼层

简单地示范了一下,请楼主认真阅读:

'* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-7-26 20:32:14 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* -----------------------------

Option Explicit Sub WriteExcel() '运行本程序前,请确认勾选了对于MICROSOFT EXCEL 10.0(视版本情况) OBJECT LIBRARY的引用 Dim ExlApp As Excel.Application, xlsWk As Excel.Workbook, EndRange As Excel.Range, Myxls As String Dim xlsSh As Excel.Worksheet, MySelects As String, N As Byte, MySelect As String, TF As Boolean Dim wdMyTable As Table On Error Resume Next '忽略错误 Myxls = "合同用款登记表1" '定义工作薄名 If Tasks.Exists("Microsoft Excel") = True Then '检测任务栏是否存在EXCEL程序 Set ExlApp = GetObject(, "Excel.Application") '如果存在,取得该程序的引用 If Tasks.Exists("Microsoft Excel - " & Myxls) = True Then '如果目标工作薄已经打开 Set xlsWk = ExlApp.Workbooks(Myxls) '取得对该工作薄的引用 Else '否则打开该工作薄 Set xlsWk = ExlApp.Workbooks.Open(ThisDocument.Path & "\" & Myxls) End If Else '否则创建对于EXCEL程序的引用 Set ExlApp = CreateObject("Excel.Application") ExlApp.Visible = True '可见 TF = True '标识一个变量值 '打开目标文档,必须在与WORD文件在同一文件夹下,否则请直接引用全路径名 Set xlsWk = ExlApp.Workbooks.Open(ThisDocument.Path & "\" & Myxls) End If VBA.AppActivate Application.Name '激活WORD程序(如果以隐藏方式打开,则更好,无需此行) For Each xlsSh In xlsWk.Worksheets '遍历工作表 N = N + 1 '累加 MySelects = MySelects & N & ":" & xlsSh.Name & ";" '文本累加 Next '返回一个INPUTBOX对话框结果 MySelect = InputBox("请选择需要记录的工作表名的序号!" & vbCrLf & MySelects) '如果为空或者用户自动输入的无效数据,则退出 If MySelect = "" Or VBA.IsNumeric(MySelect) = False Or MySelect * 1 > N Then GoTo EtSub '取得该工作表中的最后一个空白单元格对象(B列) Set EndRange = xlsWk.Worksheets(MySelect * 1).[B65536].End(xlUp).Offset(1, 0) With ThisDocument Set wdMyTable = .Tables(1) '定义一个WORD表格 '分别获得指定的单元格数据 EndRange = .Range(wdMyTable.Cell(1, 4).Range.Start, wdMyTable.Cell(1, 4).Range.End - 1) EndRange.Offset(, 1) = .Range(wdMyTable.Cell(9, 1).Range.Start, wdMyTable.Cell(9, 1).Range.End - 1) EndRange.Offset(, 2) = .Range(wdMyTable.Cell(11, 1).Range.Start, wdMyTable.Cell(11, 1).Range.End - 1) End With Exit Sub EtSub: If TF = True Then xlsWk.Close False: ExlApp.Quit End Sub '----------------------

Qv74GaJM.rar (14.72 KB, 下载次数: 95)

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-7-27 18:23 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-15 12:42 , Processed in 0.037444 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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