Function HZPY(hzstr As String) As String
Dim p0 As String, C As String, STR As String
Dim i As Integer, j As Integer
p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"
For i = 1 To Len(hzstr)
C = "z"
STR = Mid(hzstr, i, 1)
If Asc(STR) > 0 Then
C = STR
Else
For j = 1 To 26
If Mid(p0, j, 1) > STR Then
C = Chr(95 + j)
Exit For
End If
Next
End If
HZPY = HZPY + C
Next
End Function
Public Function GetFirstChr(ByVal sSrc As String)
Dim sTemp As String
sTemp = Left(sSrc, 1)
Select Case Asc(sTemp)
Case 48 To 122
GetFirstChr = sTemp
Case Is >= Asc("匝")
GetFirstChr = "Z"
Case Is >= Asc("压")
GetFirstChr = "Y"
Case Is >= Asc("昔")
GetFirstChr = "X"
Case Is >= Asc("挖")
GetFirstChr = "W"
Case Is >= Asc("塌")
GetFirstChr = "T"
Case Is >= Asc("撒")
GetFirstChr = "S"
Case Is >= Asc("然")
GetFirstChr = "R"
Case Is >= Asc("期")
GetFirstChr = "Q"
Case Is >= Asc("啪")
GetFirstChr = ""
Case Is >= Asc("哦")
GetFirstChr = "O"
Case Is >= Asc("拿")
GetFirstChr = "N"
Case Is >= Asc("妈")
GetFirstChr = "M"
Case Is >= Asc("垃")
GetFirstChr = "L"
Case Is >= Asc("喀")
GetFirstChr = "K"
Case Is >= Asc("击")
GetFirstChr = "J"
Case Is >= Asc("哈")
GetFirstChr = "H"
Case Is >= Asc("噶")
GetFirstChr = "G"
Case Is >= Asc("发")
GetFirstChr = "F"
Case Is >= Asc("蛾")
GetFirstChr = "E"
Case Is >= Asc("搭")
GetFirstChr = "D"
Case Is >= Asc("擦")
GetFirstChr = "C"
Case Is >= Asc("芭")
GetFirstChr = "B"
Case Is >= Asc("啊")
GetFirstChr = "A"
Case Else
GetFirstChr = "0"
End Select
End Function
'取得汉字的拼音缩写
Public Function GetPyAbOfHz(ByVal sHz As String) As String
Dim sTmp, ch As String
Dim i As Integer
For i = 1 To Len(sHz)
ch = Mid(sHz, i, 1)
Select Case ch
Case ".", "(", ")", "+", "-"
sTmp = sTmp & ch
Case " "
Case Else
sTmp = sTmp & GetFirstChr(ch)
End Select
Next
GetPyAbOfHz = sTmp
End Function
"