如何把word文档内每一行开头的第一个文字一次批量的改变颜色或字体？

duquancai · 发表于 2016-11-10 14:03

13907933959 发表于 2016-11-10 10:26
前辈好！
抱歉！抱歉！怪我描述不准、让您产生误判，请前辈原谅！

Sub 字符设置格式()
Dim c As New Collection, oPage As Page, oLine As Line, rng As Range, r%
r = InputBox("请输入字符数")
On Error Resume Next
For Each oPage In ActiveDocument.ActiveWindow.ActivePane.Pages
For Each oLine In oPage.Rectangles(1).Lines
If r <= oLine.Range.End - oLine.Range.Start Then
n = n + 1
Set rng = ActiveDocument.Range(oLine.Range.Start + r - 1, oLine.Range.Start + r)
c.Add rng, CStr(n)
End If
Next
Next
For i = 1 To c.Count
With c(i).Font
.Name = "黑体"
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Color = wdColorRed
End With
Next
End Sub

复制代码

13907933959 · 发表于 2016-11-10 15:06

本帖最后由 13907933959 于 2016-11-12 08:40 编辑

duquancai 发表于 2016-11-10 14:03

前辈好！

抱歉！抱歉！前天弄错了，对不住！对不住！

今天重新测试了，代码准确无误。

拜谢前辈！

13907933959 · 发表于 2016-11-13 07:26

本帖最后由 13907933959 于 2016-11-14 07:07 编辑

duquancai 发表于 2016-11-10 14:03

前辈好！
如反过来、从文档每一行的未尾（即文档内右标尺内的第一个字符）、自右往左，指定字符位数设置格式，前辈可有办法？
原因是用前辈给的这个代码设置格式时，因文档每一行标点符号、数字、符号、的多少及文字的紧密度不尽相同，导致无法准确锁定每一行未尾的字符（即文档内右标尺内的第一个字符），想求前辈再帮忙！拜谢！

13907933959 · 发表于 2016-11-14 07:06

duquancai 发表于 2016-11-10 14:03

前辈好！
如反过来、从文档每一行的未尾（即文档内右标尺内的第一个字符）、自右往左，指定字符位数设置格式，前辈可有办法？
原因是用前辈给的这个代码设置格式时，因文档每一行标点符号、数字、符号、的多少及文字的紧密度不尽相同，导致无法准确锁定每一行未尾的字符（即文档内右标尺内的第一个字符），想求前辈再帮忙！拜谢！

duquancai · 发表于 2016-11-14 10:28

13907933959 发表于 2016-11-14 07:06
前辈好！
如反过来、从文档每一行的未尾（即文档内右标尺内的第一个字符）、自右往左，指定字符位数设置 ...

Sub 字符设置格式()
Dim c As New Collection, oPage As Page, oLine As Line, rng As Range, r%
r = InputBox("请输入字符数")
On Error Resume Next
For Each oPage In ActiveDocument.ActiveWindow.ActivePane.Pages
For Each oLine In oPage.Rectangles(1).Lines
If r <= oLine.Range.End - oLine.Range.Start Then
n = n + 1
Set rng = ActiveDocument.Range(oLine.Range.End - r, oLine.Range.End - (r - 1))
rng.Select
c.Add rng, CStr(n)
End If
Next
Next
For i = 1 To c.Count
With c(i).Font
.Name = "黑体"
.Name = "Times New Roman"
.Size = 10
.Bold = True
.Color = wdColorRed
End With
Next
End Sub

复制代码

13907933959 · 发表于 2016-11-14 10:38

本帖最后由 13907933959 于 2016-11-14 11:10 编辑

duquancai 发表于 2016-11-14 10:28

前辈好！

好像还不能准确锁定。

duquancai · 发表于 2016-11-14 10:40

13907933959 发表于 2016-11-14 10:38
前辈好！好像还不能准确锁定。请见附件。

仔细看。。。。。。。（字号最好设置和原来文档中的字号一致，以便观察！！！）

13907933959 · 发表于 2016-11-14 11:10

本帖最后由 13907933959 于 2016-11-15 06:51 编辑

duquancai 发表于 2016-11-14 10:40
仔细看。。。。。。。（字号最好设置和原来文档中的字号一致，以便观察！！！）

前辈好！
按您教的就OK了。
抱歉！抱歉！水平不够＋没注意，对不住！对不住！
重新测试了，代码准确无误。
前辈、可否劳您再把 “手动换行符”、“ 段落符”，排除在外，不算在指定字符的位数内。

duquancai · 发表于 2016-11-14 11:42

13907933959 发表于 2016-11-14 11:10
前辈好！
抱歉！抱歉！水平不够＋没注意，对不住！对不住！
重新测试了，代码准确无误。

Sub 字符设置格式()
Dim c As New Collection, oPage As Page, oLine As Line, rng As Range, r%
r = InputBox("请输入字符数")
On Error Resume Next
For Each oPage In ActiveDocument.ActiveWindow.ActivePane.Pages
For Each oLine In oPage.Rectangles(1).Lines
If r <= oLine.Range.End - oLine.Range.Start Then
n = n + 1
Set rng = oLine.Range
If Right(rng, 1) = Chr(13) Or Right(rng, 1) = Chr(11) Then
Set rng = ActiveDocument.Range(oLine.Range.End - r - 1, oLine.Range.End - (r - 1) - 1)
Else
Set rng = ActiveDocument.Range(oLine.Range.End - r, oLine.Range.End - (r - 1))
End If
c.Add rng, CStr(n)
End If
Next
Next
For i = 1 To c.Count
With c(i).Font
.Name = "黑体"
.Name = "Times New Roman"
.Size = 10
.Bold = True
.Color = wdColorRed
End With
Next
End Sub

复制代码

duquancai · 发表于 2016-11-14 12:30

本帖最后由 duquancai 于 2016-11-14 12:33 编辑

13907933959 发表于 2016-11-14 11:10
前辈好！
抱歉！抱歉！水平不够＋没注意，对不住！对不住！
重新测试了，代码准确无误。

下次发帖前，自己把需求表达清楚，仔细想想自己的需求及逻辑再发帖。不要一会儿想起了一点又增加一点，对于细小的问题，自己修改就行了。写代码还是很辛苦的！

		自动登录	找回密码
密码			免费注册

[求助] 如何把word文档内每一行开头的第一个文字一次批量的改变颜色或字体？

评分