将Word中的英文单、双引号转换为中文标点，存在一个问题求助！

[myfav]

这是网上搜到的一个宏代码，能正常运行，但当中存在一个问题：
'==================================================================
Sub 英文单双引号转中文()
Dim CountD As Integer, CountS As Integer, i As Integer, j As Integer, Sh As Byte '声明变量
Dim ywdy As String, zwdy1 As String, zwdy2 As String, ywsy As String, zwsy1 As String, zwsy2 As String '声明变量

'以下代码统计出文中的引号数目(包括""“”)
On Error Resume Next
ywdy = "'"
zwdy1 = "‘"
zwdy2 = "’"
ywsy = """"
zwsy1 = "“"
zwsy2 = "”"

sure = MsgBox("请先确保您已将WORD的“工具”－自动更正选项－键入时自动套用格式－键入时自动替换－“直引号替换为弯引号”的勾已去掉。" + vbCrLf + " 如果您已去掉勾选，请点击“确定”，否则请按取消", vbOKCancel, "英文单、双引号转中文单、双引号")
If sure = 1 Then

With ActiveDocument.Content.Find
Do While .Execute(FindText:=ywdy, Forward:=True, Format:=True) = True
Countd = Countd + 1
Loop
End With
For j = 1 To Countd
Sh = j Mod 2 '求i值除以2的余数
If Sh <> 0 Then '如果余数不等于0(即为奇数)，则将相应的引号替'换为“前d”
With ActiveDocument.Content.Find
.Text = ywdy
.Replacement.Text = "前d"
.Execute Replace:=wdReplaceOne, Forward:=True
End With
Else
With ActiveDocument.Content.Find '反之则将相应的引号替换为“后d”
.Text = ywdy
.Replacement.Text = "后d"
.Execute Replace:=wdReplaceOne, Forward:=True
End With
End If
Next '进行下一对引号的替换
With ActiveDocument.Content.Find
'以下代码将所有的“前d”替换为左引号
.Text = "前d"
.Replacement.Text = zwdy1
.Execute Replace:=wdReplaceAll, Forward:=True
'以下代码将所有的“后d”替换为右引号
.Text = "后d"
.Replacement.Text = zwdy2
.Execute Replace:=wdReplaceAll, Forward:=True
End With

With ActiveDocument.Content.Find
Do While .Execute(FindText:=ywsy, Forward:=True, Format:=True) = True
Counts = Counts + 1
Loop
End With
For i = 1 To Counts
Sh = i Mod 2 '求i值除以2的余数
If Sh <> 0 Then '如果余数不等于0(即为奇数)，则将相应的引号替'换为“前d”
With ActiveDocument.Content.Find
.Text = ywsy
.Replacement.Text = "前s"
.Execute Replace:=wdReplaceOne, Forward:=True
End With
Else
With ActiveDocument.Content.Find '反之则将相应的引号替换为“后d”
.Text = ywsy
.Replacement.Text = "后s"
.Execute Replace:=wdReplaceOne, Forward:=True
End With
End If
Next '进行下一对引号的替换
With ActiveDocument.Content.Find
'以下代码将所有的“前s”替换为左引号
.Text = "前s"
.Replacement.Text = zwsy1
.Execute Replace:=wdReplaceAll, Forward:=True
'以下代码将所有的“后s”替换为右引号
.Text = "后s"
.Replacement.Text = zwsy2
.Execute Replace:=wdReplaceAll, Forward:=True
End With

ActiveDocument.Content.Font.Name = "宋体"

End If
End Sub
'==================================================================

现在有一个问题：当文章很长很长，里边的单、双引号由于疏忽、手误或遗漏等等原因，不是成对地出现时，上述宏处理的结果就乱套了！

举个例子：

　　金庸，当代著名作家，新闻学家，企业家，社会活动家。原名"查良镛（"zhā liáng yōng"，英文名"Louis Cha"），1924年3月10日生于浙江省海宁县袁花镇。作为新派武侠小说最杰出的代表作家，被誉为武侠小说家的"泰山北斗"，"金大侠"或"查大侠"。是《香港基本法》主要起草人之一，曾荣获香港"大紫荆勋章"。

会被误转为：

　　金庸，当代著名作家，新闻学家，企业家，社会活动家。原名“查良镛（”zhā liáng yōng“，英文名”Louis Cha“），1924年3月10日生于浙江省海宁县袁花镇。作为新派武侠小说最杰出的代表作家，被誉为武侠小说家的”泰山北斗“，”金大侠“或”查大侠“。是《香港基本法》主要起草人之一，曾荣获香港”大紫荆勋章“。

文章短还比较容易发现，若文章很长，这错误就很难排查了。

我初步设想的一个解决办法是：先用另一个宏代码“预处理”一遍文章，总体思路是，以“段”（回车）为单位，统计每一段当中出现的“"”与“'”的个数。若为奇数，则报错，以便修正。代码如下：

'==================================================================
Sub 全文检查单双引号是否双数()
Dim nPara As Integer, nCount As Integer, rngParagraph As Range '声明变量
nPara = ActiveDocument.Paragraphs.count '统计文章一共有多少个段落
for i = 1 to nPara '遍历全部段落
Set rngParagraph = ActiveDocument.Paragraphs(i).Range
'返回一个Range对象，该对象引用活动文档的第i个段落
if rngParagraph.Find.Execute(FindText:="'", Forward:=True) = True Then
nCount = 0
With rngParagraph.Find
Do While .Execute(FindText:="'", Forward:=True) = True
nCount = nCount + 1
Loop
if nCount Mod 2 <> 0 Then '求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
'.Parent.InsertAfter "★★★"
rngParagraph.InsertAfter "★★★"
rngParagraph.InsertParagraphAfter
endif
End With
endif

if rngParagraph.Find.Execute(FindText:="""", Forward:=True) = True Then
nCount = 0
With rngParagraph.Find
'.ClearFormatting
Do While .Execute(FindText:="""", Forward:=True) = True
nCount = nCount + 1
Loop
if nCount Mod 2 <> 0 Then '求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
'.Parent.InsertAfter "☆☆☆"
rngParagraph.InsertAfter "☆☆☆"
rngParagraph.InsertParagraphAfter
endif
End With
endif

Next '遍历全部段落的循环
End Sub
'==================================================================

但它不works! 俺的VBA还没入门，水平奇臭。宏自动插入“★★★”和“☆☆☆”，代表这一段落的单引号或双引号数目是奇数，不对，需修正！可是代码运行的结果，它们插入的地方不对。另，当文章中有表格时，表格当中的引号也并不被自动统计和处理。

特来求助，恳请帮助修改一下这段宏代码，以便真正实用。
非常非常非常感谢！

[myfav]

再看了一下别人的宏代码，原来Range确实有Text属性的，呵呵。
这下就比较简单了。

[dsd999]

在text里查找到是个好办法。

目前看来只能这么做了。

[myfav]

自己再摸了一下，解决了。基本功不扎实，害死人哪！
'==================================================================
Sub 全文检查单双引号是否双数()
Dim nPara As Integer, nCount As Integer '声明变量
Dim nOld As Integer, nNew As Integer
Dim rngParagraph As Range, strParagraph As String
nPara = ActiveDocument.Paragraphs.Count '统计文章一共有多少个段落
For i = 1 To nPara '遍历全部段落
Set rngParagraph = ActiveDocument.Paragraphs(i).Range
'返回一个Range对象，该对象引用活动文档的第i个段落
strParagraph = rngParagraph.Text

nOld = Len(strParagraph)
nNew = Len(Replace(strParagraph, """", ""))
nCount = nOld - nNew
If nCount Mod 2 <> 0 Then
'求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
With rngParagraph
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter "☆☆☆"
End With
End If

nNew = Len(Replace(strParagraph, "'", ""))
nCount = nOld - nNew
If nCount Mod 2 <> 0 Then
'求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
With rngParagraph
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter "★★★"
End With
End If

Next '遍历全部段落的循环
End Sub
'==================================================================

[dsd999]

上面的代码是搜索整个文本引号的个数，不是每个段落的。

解决方法我也上谷歌搜搜。

[myfav]

[Quote=引用 1 楼 的回复:]
上面的代码是搜索整个文本引号的个数，不是每个段落的。

解决方法我也上谷歌搜搜。
[/Quote]

非常感谢dsd999的关注！

确实如此，我试了一晚上，也注意到这个问题了。我原以为，设置一个段落作为Range，再执行Find操作，就能够将搜索范围限定在此段落以内，没承想Word居然没有“在范围内搜索”的选项！它确实是一路往下搜索到 了文章尾。我将代码反复改了半天，一直都没能改好。这才发觉：用VBA操作Word，并非想像中那么简单。

又：有没办法获得一个段落的完整文本字符？若能获得，则赋值到一个字符串变量，也能借助InStr函数来统计引号数量啊，可找了半天，Paragraphs、Paragraph、Range，都没有类似Text这样的属性。

还想到一个办法，可是比较复杂，且浪费运行时间，那就是：

先开一个新的临时文件。然后在源文件中遍历全部段落，每一个段落全选，复制，切换到临时文件中，粘贴。然后，在临时文件中全文搜索引号，统计。再切换回源文件，重复下一个段落……当文章很长时，这一系列操作，恐怕相当费时！而且代码有点儿复杂，我一下子也写不出来。

恳请高手帮心忙啊！非常感谢！

[myfav]

这是反复修改后的宏代码，可惜仍然无法得到正确结果：
'==================================================================
Sub 全文检查单双引号是否双数()
Dim nPara As Integer, i As Integer, nCount As Integer '声明变量
nPara = ActiveDocument.Paragraphs.count '统计文章一共有多少个段落
for i = 1 to nPara '遍历全部段落
nCount = 0
With ActiveDocument.Paragraphs(i).Range.Find
'.ClearFormatting
Do While .Execute(FindText:="""", Forward:=True) = True
nCount = nCount + 1
Loop
if nCount Mod 2 <> 0 Then
'求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
With ActiveDocument.Paragraphs(i).Range
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter "☆☆☆"
End With
endif
End With

nCount = 0
With ActiveDocument.Paragraphs(i).Range.Find
Do While .Execute(FindText:="'", Forward:=True) = True
nCount = nCount + 1
Loop
if nCount Mod 2 <> 0 Then
'求nCount值除以2的余数，如果余数不等于0(即为奇数)，则有错！
With ActiveDocument.Paragraphs(i).Range
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter "★★★"
End With
endif
End With

Next '遍历全部段落的循环
End Sub
'==================================================================