vb 输入名称的首字拼音 取汉字首字母

Private Sub Command1_Click()

Dim t1, t2 As String

t1 = Text1.Text

t2 = GetPY(CStr(t1))

Text2.Text = t2

End Sub

Function GetPY(a1 As String) As String

'获得输入名称的首字拼音

Dim

t1

As String

If Asc(a1) < 0 Then

t1 = Left(a1, 1)

If Asc(t1) < Asc("啊") Then

GetPY = "0"

Exit Function

End If

If Asc(t1) >= Asc("啊") And Asc(t1) <

Asc("芭") Then

GetPY = "A"

Exit Function

End If

If Asc(t1) >= Asc("芭") And Asc(t1) <

Asc("擦") Then

GetPY = "B"

Exit Function

End If

If Asc(t1) >= Asc("擦") And Asc(t1) <

Asc("搭") Then

GetPY = "C"

Exit Function

End If

If Asc(t1) >= Asc("搭") And Asc(t1) <

Asc("蛾") Then

GetPY = "D"

Exit Function

End If

If Asc(t1) >= Asc("蛾") And Asc(t1) <

Asc("发") Then

GetPY = "E"

Exit Function

End If

If Asc(t1) >= Asc("发") And Asc(t1) <

Asc("噶") Then

GetPY = "F"

Exit Function

End If

If Asc(t1) >= Asc("噶") And Asc(t1) <

Asc("哈") Then

GetPY = "G"

Exit Function

End If

If Asc(t1) >= Asc("哈") And Asc(t1) <

Asc("击") Then

GetPY = "H"

Exit Function

End If

If Asc(t1) >= Asc("击") And Asc(t1) <

Asc("喀") Then

GetPY = "J"

Exit Function

End If

If Asc(t1) >= Asc("喀") And Asc(t1) <

Asc("垃") Then

GetPY = "K"

Exit Function

End If

If Asc(t1) >= Asc("垃") And Asc(t1) <

Asc("妈") Then

GetPY = "L"

Exit Function

End If

If Asc(t1) >= Asc("妈") And Asc(t1) <

Asc("拿") Then

GetPY = "M"

Exit Function

End If

If Asc(t1) >= Asc("拿") And Asc(t1) <

Asc("哦") Then

GetPY = "N"

Exit Function

End If

If Asc(t1) >= Asc("哦") And Asc(t1) <

Asc("啪") Then

GetPY = "O"

Exit Function

End If

If Asc(t1) >= Asc("啪") And Asc(t1) <

Asc("期") Then

GetPY = "P"

Exit Function

End If

If Asc(t1) >= Asc("期") And Asc(t1) <

Asc("然") Then

GetPY = "Q"

Exit Function

End If

If Asc(t1) >= Asc("然") And Asc(t1) <

Asc("撒") Then

GetPY = "R"

Exit Function

End If

If Asc(t1) >= Asc("撒") And Asc(t1) <

Asc("塌") Then

GetPY = "S"

Exit Function

End If

If Asc(t1) >= Asc("塌") And Asc(t1) <

Asc("挖") Then

GetPY = "T"

Exit Function

End If

If Asc(t1) >= Asc("挖") And Asc(t1) <

Asc("昔") Then

GetPY = "W"

Exit Function

End If

If Asc(t1) >= Asc("昔") And Asc(t1) <

Asc("压") Then

GetPY = "X"

Exit Function

End If

If Asc(t1) >= Asc("压") And Asc(t1) <

Asc("匝") Then

GetPY = "Y"

Exit Function

End If

If Asc(t1) >= Asc("匝") Then

GetPY = "Z"

Exit Function

End If

Else

If UCase(a1) <= "Z" And UCase(a1) >=

"A" Then

GetPY = UCase(Left(a1, 1))

Else

GetPY = "0"

End If

End If

End Function

分享

顶