Sub QuickPinyin()

    Dim Pre As String, Post As String, C As String, Chunk As String
    Dim I As Integer, L As Integer
    
    Pre = InputBox("Enter Pinyin text:" + Chr$(10) + Chr$(13) + "- Use numbers 1-4 for tone marks, 0 for no mark" + Chr$(10) + Chr$(13) + "- Use 'uu' for 'u' with umlaut", "QuickPinyin")
    
    L = Len(Pre)
    For I = 1 To L
        C = Mid$(Pre, I, 1)
        If C >= "0" And C <= "4" Then
            Post = Post + PinyinTone(PinyinUmlaut(Chunk), Int(C))
            Chunk = ""
        Else
            Chunk = Chunk + C
        End If
    Next I
    Post = Post + PinyinUmlaut(Chunk)
    
    Selection.TypeText Post

End Sub

Function PinyinUmlaut(S As String) As String

    Dim I As Integer, L As Integer, C As String
    L = Len(S)
    For I = 1 To L
        C = Mid$(S, I, 2)
        If C = "uu" Then
            PinyinUmlaut = PinyinUmlaut + ChrW$(252)
            I = I + 1
        ElseIf (C = "Uu") Or (C = "Uu") Then
            PinyinUmlaut = PinyinUmlaut + ChrW$(220)
            I = I + 1
        Else
            PinyinUmlaut = PinyinUmlaut + Left$(C, 1)
        End If
    Next I

End Function

Function PinyinTone(S As String, Tone As Integer) As String

    Dim P As Integer

    P = InStrRev(S, "a")
    If P = 0 Then P = InStrRev(S, "A")
    If P <> 0 Then
        PinyinTone = PinyinToneAt(S, P, Tone)
    Else
        P = InStrRev(S, "o")
        If P = 0 Then P = InStrRev(S, "O")
        If P <> 0 Then
            PinyinTone = PinyinToneAt(S, P, Tone)
        Else
            P = InStrRev(S, "e")
            If P = 0 Then P = InStrRev(S, "E")
            If P <> 0 Then
                PinyinTone = PinyinToneAt(S, P, Tone)
            Else
                P = InStrRev(S, "i")
                If P = 0 Then P = InStrRev(S, "I")
                If P <> 0 Then
                    PinyinTone = PinyinToneAt(S, P, Tone)
                Else
                    P = InStrRev(S, "u")
                    If P = 0 Then P = InStrRev(S, "U")
                    If P <> 0 Then
                        PinyinTone = PinyinToneAt(S, P, Tone)
                    Else
                        P = InStrRev(S, ChrW$(252))
                        If P = 0 Then P = InStrRev(S, ChrW$(220))
                        If P <> 0 Then
                            PinyinTone = PinyinToneAt(S, P, Tone)
                        End If
                    End If
                End If
            End If
        End If
    End If

End Function

Function PinyinToneAt(S As String, Position As Integer, Tone As Integer) As String

    PinyinToneAt = Left$(S, Position - 1) + PinyinMark(Mid$(S, Position, 1), Tone) + Mid$(S, Position + 1)

End Function

Function PinyinMark(Character As String, Tone As Integer) As String

    Select Case Character
        Case "a"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(257)
                Case 2
                    PinyinMark = ChrW$(225)
                Case 3
                    PinyinMark = ChrW$(462)
                Case 4
                    PinyinMark = ChrW$(224)
                Case Else
                    PinyinMark = Character
            End Select
        Case "e"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(275)
                Case 2
                    PinyinMark = ChrW$(233)
                Case 3
                    PinyinMark = ChrW$(283)
                Case 4
                    PinyinMark = ChrW$(232)
                Case Else
                    PinyinMark = Character
            End Select
        Case "i"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(299)
                Case 2
                    PinyinMark = ChrW$(237)
                Case 3
                    PinyinMark = ChrW$(464)
                Case 4
                    PinyinMark = ChrW$(236)
                Case Else
                    PinyinMark = Character
            End Select
        Case "o"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(333)
                Case 2
                    PinyinMark = ChrW$(243)
                Case 3
                    PinyinMark = ChrW$(466)
                Case 4
                    PinyinMark = ChrW$(242)
                Case Else
                    PinyinMark = Character
            End Select
        Case "u"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(363)
                Case 2
                    PinyinMark = ChrW$(250)
                Case 3
                    PinyinMark = ChrW$(468)
                Case 4
                    PinyinMark = ChrW$(249)
                Case Else
                    PinyinMark = Character
            End Select
        Case ChrW$(220)
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(469)
                Case 2
                    PinyinMark = ChrW$(471)
                Case 3
                    PinyinMark = ChrW$(473)
                Case 4
                    PinyinMark = ChrW$(475)
                Case Else
                    PinyinMark = Character
            End Select
        Case "A"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(256)
                Case 2
                    PinyinMark = ChrW$(193)
                Case 3
                    PinyinMark = ChrW$(461)
                Case 4
                    PinyinMark = ChrW$(192)
                Case Else
                    PinyinMark = Character
            End Select
        Case "E"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(274)
                Case 2
                    PinyinMark = ChrW$(201)
                Case 3
                    PinyinMark = ChrW$(282)
                Case 4
                    PinyinMark = ChrW$(200)
                Case Else
                    PinyinMark = Character
            End Select
        Case "I"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(298)
                Case 2
                    PinyinMark = ChrW$(205)
                Case 3
                    PinyinMark = ChrW$(463)
                Case 4
                    PinyinMark = ChrW$(204)
                Case Else
                    PinyinMark = Character
            End Select
        Case "O"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(332)
                Case 2
                    PinyinMark = ChrW$(211)
                Case 3
                    PinyinMark = ChrW$(465)
                Case 4
                    PinyinMark = ChrW$(210)
                Case Else
                    PinyinMark = Character
            End Select
        Case "U"
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(362)
                Case 2
                    PinyinMark = ChrW$(218)
                Case 3
                    PinyinMark = ChrW$(467)
                Case 4
                    PinyinMark = ChrW$(217)
                Case Else
                    PinyinMark = Character
            End Select
        Case ChrW$(252)
            Select Case Tone
                Case 1
                    PinyinMark = ChrW$(470)
                Case 2
                    PinyinMark = ChrW$(472)
                Case 3
                    PinyinMark = ChrW$(474)
                Case 4
                    PinyinMark = ChrW$(476)
                Case Else
                    PinyinMark = Character
            End Select
        Case Else
            PinyinMark = Character
    End Select

End Function