|
请运行以下代码： '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-6-1 5:33:27
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－Option Explicit
Sub CharactersSortCounts()
'文档字数分类统计代码,主要统计中文字符,中文标点总数,英文字符数,英文标点总数
'以及其它字符数
Dim ChineseInterPunction As String, EnglishInterPunction As String
Dim aChar As Range, AscaChar As Long, aVar As Variable
Dim CIPCount As Integer, ChineseCount As Integer, EIPCount As Integer
Dim EnglishCount As Integer, BlankCount As Integer, Others As Integer
Dim MyRange As Range, MyLable As String
'如果未选定
If Selection.Type = wdSelectionIP Then
'定义一个全文档RANGE对象
Set MyRange = ThisDocument.Content
MyLable = "全文档"
Else
'定义一个选定区域的RANGE对象
Set MyRange = Selection.Range
MyLable = "选定文本"
End If
'定义中文标点符,可继续扩充
ChineseInterPunction = "。，；：？！……—～〔〕《》‘’“”"
'定义英文标点符,可继续扩充
EnglishInterPunction = ".,;:?!…-~()<>'"""""
With MyRange
For Each aChar In .Characters
AscaChar = VBA.Asc(aChar)
'如果含有中文标点则计数
If VBA.InStr(ChineseInterPunction, aChar) > 0 Then
CIPCount = CIPCount + 1
'如果含有英文标点计数
ElseIf VBA.InStr(EnglishInterPunction, aChar) > 0 Then
EIPCount = EIPCount + 1
'如果为半角空格则计数
ElseIf AscaChar = 32 Then
BlankCount = BlankCount + 1
'如果为英文字符(包含CHR(13))则计数
ElseIf AscaChar >= 0 And AscaChar <= 255 Then
EnglishCount = EnglishCount + 1
'如果为简体中文则计数
ElseIf AscaChar < -2050 And AscaChar > -20319 Then
ChineseCount = ChineseCount + 1
Else
'累计其它
Others = Others + 1
End If
Next
'显示统计结果
MsgBox MyLable & "字数统计:" & vbCrLf & "字符总数: " & .Characters.Count - _
.Paragraphs.Count & _
vbCrLf & "段落总数: " & .Paragraphs.Count & _
vbCrLf & "空格总数: " & BlankCount & vbCrLf & _
"英文标点总数: " & EIPCount & vbCrLf & _
"英文字符数(不含空格,英文标点): " & EnglishCount & _
vbCrLf & "中文标点总数: " & CIPCount & vbCrLf & _
"中文字符总数(不含中文标点): " & ChineseCount & _
vbCrLf & "其它字符数: " & Others, vbOKOnly + vbInformation, "Microsoft Word"
End With
End Sub
'---------------------- | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-5-31 12:47
楼主