ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[分享]WORD的公式自动填充代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2004-8-31 19:52 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

WORD表格中少量、简单、分配合理计算公式使用域计算,也不失为一种好方法至少可以免去在EXCEL中的复制与粘贴工作或者以插入对象的方式进行。

如何使WORD中的公式类似EXCEL中填充那样方便,是本贴进行研究的对象,当然受到WORD资源限制仅能部分类似,但也总算是一种自慰吧,也是对EXCEL不熟悉的网友的一种帮助更是WORD中域功能的一种开发。

显然,它需要有严格的限制,只能在符合数据库特征的表格中进行并且,公式在列中填充时公式中引用的行号是一致的,如最后一列为E列,则必须是类似于E1=A1+B1-C1*D1,即同一行号引用;如果是在行中填充,如最后一行为6, 则必须是类似于A6=A1/A2*A3+A4-A5形式即其中的列号(A)为同一列引用。

但在最终测试过程中我发现了一个奇怪的问题部分机器不完全支持以下代码主要是行中的公式填充。

请在使用之前确认工具/选项/视图/域代码前打勾。

希望能对大家有所裨益。

Sub AutoFormula() Dim RsNum As Integer, Csnum As Byte, ReNum As Integer, CeNum As Byte, i As Integer On Error GoTo ErrorHandle With Selection RsNum = .Information(wdStartOfRangeRowNumber) Csnum = .Information(wdStartOfRangeColumnNumber) ReNum = .Information(wdEndOfRangeRowNumber) CeNum = .Information(wdEndOfRangeColumnNumber) Application.ScreenUpdating = False .Cells(1).Range.Fields(1).Copy .Paste ActiveWindow.View.ShowFieldCodes = True If Csnum = CeNum Then For i = RsNum + 1 To ReNum .Tables(1).Cell(i, CeNum).Range.Find.Execute findtext:=RsNum, replacewith:=i, Replace:=wdReplaceAll Next End If If RsNum = ReNum Then For i = Csnum + 97 To CeNum + 96 .Tables(1).Cell(RsNum, i - 96).Range.Find.Execute findtext:=Chr(Csnum + 96), MatchCase:=False, replacewith:=Chr(i), Replace:=wdReplaceAll Next End If ActiveWindow.View.ShowFieldCodes = False ActiveDocument.Fields.Update Application.ScreenUpdating = True End With Exit Sub ErrorHandle: MsgBox "请检查域公式或者选定区域是否为表格中以及选定区域是否为表格中", vbOKOnly + vbInformation End Sub

TA的精华主题

TA的得分主题

发表于 2004-9-10 18:38 | 显示全部楼层
守柔的研究,真是值得称道。

TA的精华主题

TA的得分主题

发表于 2004-9-10 19:48 | 显示全部楼层

守柔版主,我真的很配服你,因为我对VBA是一窍不通。有机会一定好好向你学习学习。

不知道可不可以介绍一下你学习VBA的经验。

TA的精华主题

TA的得分主题

 楼主| 发表于 2004-9-10 20:08 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

如意你好,知你在精英论坛中收获颇丰。

VBA是OFFICE赋于人机对话的一种方式,是将操作后台自动化的一种方式, 是一种面向对象的工作方法,通过VBA,我们可以达到同样的操作,无论是键盘输入还是鼠标操作甚至于音频操作,因为它们都是面向对象的一种工作方法。

VBA是基于Visual Baisc for Applications的一种结构语言学习VBA通常可以从录制宏入门通过不段的学习与锻炼,来完成各种复杂问题的方法。

我想,VBA可以从宏开始学习,对象通常从SELECTION对象开始学习。

但需要指出的是,VBA不是一蹴而就的,它需要有深刻的键盘鼠标操作经验,熟悉前台对象的各种操作方法尔后才能设计出合理的后台操作代码。如果对WORD前台功能的一些对象属性与方法知之甚少想直接进行VBA操作是很难的。

TA的精华主题

TA的得分主题

发表于 2013-7-6 12:53 | 显示全部楼层
  1. Sub AutoFormula()
  2. Dim RsNum As Integer, Csnum As Byte, ReNum As Integer, CeNum As Byte, i As Integer
  3. On Error GoTo ErrorHandle
  4. With Selection
  5. RsNum = .Information(wdStartOfRangeRowNumber)
  6. Csnum = .Information(wdStartOfRangeColumnNumber)
  7. ReNum = .Information(wdEndOfRangeRowNumber)
  8. CeNum = .Information(wdEndOfRangeColumnNumber)
  9. Application.ScreenUpdating = False
  10. .Cells(1).Range.Fields(1).Copy
  11. .Paste
  12. ActiveWindow.View.ShowFieldCodes = True
  13. If Csnum = CeNum Then
  14. For i = RsNum + 1 To ReNum
  15. .Tables(1).Cell(i, CeNum).Range.Find.Execute findtext:=RsNum, replacewith:=i, Replace:=wdReplaceAll
  16. Next
  17. End If
  18. If RsNum = ReNum Then
  19. For i = Csnum + 97 To CeNum + 96
  20. .Tables(1).Cell(RsNum, i - 96).Range.Find.Execute findtext:=Chr(Csnum + 96), MatchCase:=False, replacewith:=Chr(i), Replace:=wdReplaceAll
  21. Next
  22. End If
  23. ActiveWindow.View.ShowFieldCodes = False
  24. ActiveDocument.Fields.Update
  25. Application.ScreenUpdating = True
  26. End With
  27. Exit Sub
  28. ErrorHandle: MsgBox "请检查域公式或者选定区域是否为表格中以及选定区域是否为表格中", vbOKOnly + vbInformation
  29. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2024-10-31 13:47 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
工作中真的实用!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-13 14:51 , Processed in 0.033421 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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