这个vba程序（宏）用于普通话拼音的转换数字标调为符号标调，比如，“妈”的拼音可以方便地写成ma1，但正规地写法是mā，这里的1表示阴平，那么2表示阳平，3上声，4去声，5表示轻声，一般不标写。

汉语拼音的编码表示有几种方法，这里使用的是元音字母跟声调结合在一起作为一个独立实体的编码方法：

其他声调编码表示方法，如声调作为拼音字母的附加符号，两者分开为两个实体。详细见：http://www.pinyin.info/unicode/unicode_test.html#combining。

有时候拼音字母需要大写，用于句首、人名、地名，或则干脆就是为了大写，跟小写一样也有不同的表示方法，这里也使用的元音字母跟声调结合作为一个独立实体的编码：

数字声调写在音节末尾位置，比如“上”shang4，声调符号标写在元音a上方。所以在转换时，将音节末尾位置的数字声调移动到元音a后面，写成sha4ng。然后将sha4ng这个字符串中的a4替换为à。所以将数字标调转换为符号标调，这里分两个步骤：

1.将音节末尾位置的数字移到主元音后面。

2.将元音和数字结合的字符串替换为拼音和声调结合的符号。

以下是Erik Peterson写的VBA宏，我加了一些中文注释。

Public Sub Add_Tones()

' Add_Tones

'

' Created June 15, 2000 by Erik Peterson

' Based on Slippery Sinifier

' Created May 20, 1997 by Bruce Rusk

' Freely distributable and usable with any

' modification whatever.

'

Dim strSearchText(110) As String'存放被替换的数字标调字符串，比如r1,ng1等等

Dim strPYTone(110) As String'存放改变了数字调位置的字符串，比如1r，1ng等等

Dim count As Integer

' These arrays hold the codes to be searched for

Dim strPYFont As String

' Name of the Chinese font. Modify if desired; may be

' linked to a user form &c.

strPYFont = "Chinese Pinyin"

Application.ScreenUpdating = False

' The screen would get too messy if we let it redraw. It

' would also slow down operation.

'用于儿化音节，比如“huar1”，在r后面的声调移到r前面。

strSearchText(1) = "r1":strPYTone(1) = "1r"

strSearchText(2) = "r2":strPYTone(2) = "2r"

strSearchText(3) = "r3":strPYTone(3) = "3r"

strSearchText(4) = "r4":strPYTone(4) = "4r"

strSearchText(5) = "r5":strPYTone(5) = "5r"

'后鼻音

strSearchText(6) = "ng1": strPYTone(6) = "1ng"

strSearchText(7) = "ng2": strPYTone(7) = "2ng"

strSearchText(8) = "ng3": strPYTone(8) = "3ng"

strSearchText(9) = "ng4": strPYTone(9) = "4ng"

strSearchText(10) = "ng5": strPYTone(10) = "5ng"

'前鼻音

strSearchText(11) = "n1": strPYTone(11) = "1n"

strSearchText(12) = "n2": strPYTone(12) = "2n"

strSearchText(13) = "n3": strPYTone(13) = "3n"

strSearchText(14) = "n4": strPYTone(14) = "4n"

strSearchText(15) = "n1": strPYTone(15) = "5n"

'复元音声调标写在主元音上

strSearchText(16) = "ai1": strPYTone(16) = "a1i"

strSearchText(17) = "ai2": strPYTone(17) = "a2i"

strSearchText(18) = "ai3": strPYTone(18) = "a3i"

strSearchText(19) = "ai4": strPYTone(19) = "a4i"

strSearchText(20) = "ai5": strPYTone(20) = "a5i"

strSearchText(21) = "ei1": strPYTone(21) = "e1i"

strSearchText(22) = "ei2": strPYTone(22) = "e2i"

strSearchText(23) = "ei3": strPYTone(23) = "e3i"

strSearchText(24) = "ei4": strPYTone(24) = "e4i"

strSearchText(25) = "ei5": strPYTone(25) = "e5i"

strSearchText(26) = "ao1": strPYTone(26) = "a1o"

strSearchText(27) = "ao2": strPYTone(27) = "a2o"

strSearchText(28) = "ao3": strPYTone(28) = "a3o"

strSearchText(29) = "ao4": strPYTone(29) = "a4o"

strSearchText(30) = "ao5": strPYTone(30) = "a5o"

strSearchText(31) = "ou1": strPYTone(31) = "o1u"

strSearchText(32) = "ou2": strPYTone(32) = "o2u"

strSearchText(33) = "ou3": strPYTone(33) = "o3u"

strSearchText(34) = "ou4": strPYTone(34) = "o4u"

strSearchText(35) = "ou5": strPYTone(35) = "o5u"

'ChrW( )函数将编码转化字符，不使用chr()是因为，这里转化的是Unicode款字符串。轻声不标调。

strSearchText(36) = "a1": strPYTone(36) = ChrW(&H101)

strSearchText(37) = "a2": strPYTone(37) = ChrW(&HE1)

strSearchText(38) = "a3": strPYTone(38) = ChrW(&H1CE)

strSearchText(39) = "a4": strPYTone(39) = ChrW(&HE0)

strSearchText(40) = "a5": strPYTone(40) = "a"

strSearchText(41) = "e1": strPYTone(41) = ChrW(&H113)

strSearchText(42) = "e2": strPYTone(42) = ChrW(&HE9)

strSearchText(43) = "e3": strPYTone(43) = ChrW(&H11B)

strSearchText(44) = "e4": strPYTone(44) = ChrW(&HE8)

strSearchText(45) = "e5": strPYTone(45) = "e"

strSearchText(46) = "i1": strPYTone(46) = ChrW(&H12B)

strSearchText(47) = "i2": strPYTone(47) = ChrW(&HED)

strSearchText(48) = "i3": strPYTone(48) = ChrW(&H1D0)

strSearchText(49) = "i4": strPYTone(49) = ChrW(&HEC)

strSearchText(50) = "i5": strPYTone(50) = "i"

strSearchText(51) = "o1": strPYTone(51) = ChrW(&H14D)

strSearchText(52) = "o2": strPYTone(52) = ChrW(&HF3)

strSearchText(53) = "o3": strPYTone(53) = ChrW(&H1D2)

strSearchText(54) = "o4": strPYTone(54) = ChrW(&HF2)

strSearchText(55) = "o5": strPYTone(55) = "o"

strSearchText(56) = "u1": strPYTone(56) = ChrW(&H16B)

strSearchText(57) = "u2": strPYTone(57) = ChrW(&HFA)

strSearchText(58) = "u3": strPYTone(58) = ChrW(&H1D4)

strSearchText(59) = "u4": strPYTone(59) = ChrW(&HF9)

strSearchText(60) = "u5": strPYTone(60) = "u"

strSearchText(61) = "u:1": strPYTone(61) = ChrW(&H1D6)

strSearchText(62) = "u:2": strPYTone(62) = ChrW(&H1D8)

strSearchText(63) = "u:3": strPYTone(63) = ChrW(&H1DA)

strSearchText(64) = "u:4": strPYTone(64) = ChrW(&H1DC)

strSearchText(65) = "u:5": strPYTone(65) = ChrW(&HFC)

strSearchText(66) = "u:": strPYTone(66) = ChrW(&HFC)

'这里将大写的A1替换为小写的a1是不正确的，大写的Ā （&H0100）用于句首、人名、地名，应该改成ChrW(&H100)，在转换的时候就正确了。不过这很少用到。

'strSearchText(67) = "A1": strPYTone(67) = "a1"

'strSearchText(68) = "A2": strPYTone(68) = "a2"

'strSearchText(69) = "A3": strPYTone(69) = "a3"

'strSearchText(70) = "A4": strPYTone(70) = "a4"

strSearchText(67) = "A1": strPYTone(67) = ChrW(&H100)

strSearchText(68) = "A2": strPYTone(68) = ChrW(&HC1)

strSearchText(69) = "A3": strPYTone(69) = ChrW(&HCD)

strSearchText(70) = "A4": strPYTone(70) = ChrW(&HC0)

strSearchText(71) = "E1": strPYTone(71) = "e1"

For count = 1 To 71

'查找、替换

With Selection.Find

' Search only in the selected text; could be

' modified to search entire document.

.ClearFormatting

.MatchWildcards = False

.MatchCase = True

'.Font.Name = "Times New Roman"

.Text = strSearchText(count)‘查找的内容

' Search for the concatenated search text.

With .Replacement

.ClearFormatting

.LanguageID = wdNoProofing

'.Font.Name = strPYFont

.Text = strPYTone(count) ‘替换的内容

End With

.Execute Replace:=wdReplaceAll

' Replace throughout the selected area

End With

Next

' be polite and clear the search dialog

With Selection.Find

.ClearFormatting

.MatchWildcards = False

.Text = ""

With .Replacement

.ClearFormatting

.Text = ""

End With

End With

Application.ScreenUpdating = True

' Turn display back on

End Sub