请参: '* +++++++++++++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-1-13 15:02:01 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* -------------------------------------------------------------------------- Sub LinesCount()
Dim l As String, LineCount As Integer, i As Integer, RangeStart As Long, RangeEnd As Long
Dim MyRange As Range
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕更新
CommandBars("Word Count").Visible = True '打开字数统计工具栏
'执行字数统计(重新计数)
CommandBars("Word Count").Controls(2).Execute
'返回第一个列表框中的第六个数据
l = CommandBars("Word Count").Controls(1).List(6)
'关闭字数统计
CommandBars("Word Count").Visible = False
Application.ScreenUpdating = True '恢复屏幕更新
LineCount = Int(Mid(l, 1, Len(l) - 1)) '返回行数值
With ActiveDocument
For i = 1 To LineCount
If .Content.End <= 1 Then Exit Sub '如果没有文档内容则退出宏
RangeStart = .GoTo(wdGoToLine, , i).Start '行起点
'如果到达最后一行,则为文档尾位置
RangeEnd = VBA.IIf(i = LineCount, .Content.End, .GoTo(wdGoToLine, , i + 1).Start)
'定义一个RANGE对象
Set MyRange = .Range(RangeStart, RangeEnd)
'添加书签
MyRange.Bookmarks.Add Name:="A" & i
Next
End With
End Sub
'---------------------- |