ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助]编程实现上下行中部分文字对齐

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-7-14 17:29 | 显示全部楼层 |阅读模式

使用vba编程时,碰到需要将两行中的部分文字对齐,我想将下面修改前文档中的“计算日期”与下行中的“界址点数”使用TAB对齐。努力了很久,没有解答。望各位大大教我。

我的代码如下:

Sub a() Dim a As Integer, b As Integer, c As Integer Dim i As Paragraph Dim myrange As Range For Each i In ActiveDocument.Paragraphs If i.Range.Find.Execute(FindText:="计算日期", Forward:=True, Wrap:=wdFindStop) = True Then Set myrange = ActiveDocument.Range(i.Range.Start, i.Next.Range.End - 1) With i.Range.Find .Execute FindText:="计算日期", Forward:=True a = .Parent.Information(wdHorizontalPositionRelativeToPage) End With With myrange.Find .Execute FindText:="界址点数", Forward:=True b = .Parent.Information(wdHorizontalPositionRelativeToPage) c = a - b MsgBox c If c < 0 Then myrange = VBA.Replace(myrange, jsrqtext, String(-c, 9) & jsrqtext) ElseIf c > 0 Then myrange = VBA.Replace(myrange, jzdstext, String(c, 9) & jzdstext) End If End With End If Next End Sub

文档处理修改前:

宗地面积量算表

土地使用者:北京经济技术开发区

土地坐落: 北门口村1

地类号:

面积(平米):16022.9 计算日期: 2005年7月12日

宗地编号: 北门口村1总面积 界址点数: 24

宗地面积量算表

土地使用者:北京经济技术开发区

土地坐落: 北门口村2

地类号:

面积(平米):205007.4 计算日期: 2005年7月12日

宗地编号: 北门口村2总面积 界址点数: 78

文档处理修改后:

宗地面积量算表

土地使用者:北京经济技术开发区

土地坐落: 北门口村1

地类号:

面积(平米):16022.9 计算日期: 2005年7月12日

宗地编号: 北门口村1总面积 界址点数: 24

宗地面积量算表

土地使用者:北京经济技术开发区

土地坐落: 北门口村2

地类号:

面积(平米):205007.4 计算日期: 2005年7月12日

宗地编号: 北门口村2总面积 界址点数: 78

附带修改前后文本:

dFLmpcU2.rar (20.4 KB, 下载次数: 30)

TA的精华主题

TA的得分主题

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

请参考:

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

Option Explicit Sub Example() Dim MyFindRange As Range, Pos As Integer Dim KeyRange As Range, i As Paragraph Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument For Each i In .Paragraphs With i If VBA.InStr(.Range, "计算日期:") > 0 Or VBA.InStr(.Range, "界址点数:") > 0 Then .Range.Find.Execute findtext:="^t", replacewith:="", Replace:=wdReplaceAll '在文档的8厘米处增加一个制表位 .TabStops.Add Position:=Word.CentimetersToPoints(8) Pos = VBA.IIf(VBA.InStr(.Range, "计算日期:") > 0, VBA.InStr(.Range, "计算日期:"), VBA.InStr(.Range, "界址点数:")) '取得指定的文本所在位置的RANGE对象 Set KeyRange = ActiveDocument.Range(.Range.Start + Pos - 1, .Range.Start + Pos - 1) '插入一个TAB键(移至指定制表位) KeyRange.InsertAfter vbTab End If End With Next End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-7-14 21:05 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2005-7-18 15:42 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

二楼的代码,自我感觉很不好。抽空重新做了一个,应该运行速度大大高于在段落中的循环了。

请楼主再试用一下:

'* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-7-18 15:43:54 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 0003^The Code CopyIn [ThisDocument-ThisDocument]^' '* -----------------------------

Sub Example2() Dim MyFindRange As Range, MyFindText As Variant, aText As Variant Dim Pos As Long, MyRange As Range ' Debug.Print Timer Application.ScreenUpdating = False MyFindText = Array("计算日期:", "界址点数:") For Each aText In MyFindText Set MyFindRange = ThisDocument.Content With MyFindRange.Find .ClearFormatting Do While .Execute(findtext:=aText & vbTab) Set MyRange = MyFindRange.Paragraphs(1).Range With MyRange '去除所有该段落中的制表位 .Text = VBA.Replace(MyRange, vbTab, "") '在文档的8厘米处增加一个制表位 .Paragraphs.TabStops.Add Position:=Word.CentimetersToPoints(8) Pos = VBA.InStr(.Text, aText) '取得指定的文本所在位置的RANGE对象 Set MyRange = ThisDocument.Range(.Start + Pos - 1, .Start + Pos - 1) MyRange.InsertAfter vbTab End With '插入一个TAB键(移至指定制表位) Loop End With Next Application.ScreenUpdating = True ' Debug.Print Timer End Sub '---------------------

TA的精华主题

TA的得分主题

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

本版积分规则

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

GMT+8, 2024-11-15 10:30 , Processed in 0.037982 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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