Attribute VB_Name = "NewMacros"
Sub Pin2Pal()
'
' Pin2Pal - Макрос преобразования пиньиня в систему Палладия в выделенном тексте Word
' Виталий Загребельный, 2025
'
Dim Pin2PalTab As String
Dim arr1() As String
Dim token() As String
Dim Pin(500) As String
Dim Pal(500) As String
Dim PinToneI(500) As Integer
Dim PalToneI(500) As Integer

Dim Result As String
Dim Wp As String
Dim Char1 As String
Dim WpLen As Integer
Dim WpLen0 As Integer
Dim Blanks As String


Call PrepareTables(Pin2PalTab)           ' Подготовка таблиц перекодировки

arr1 = Split(Pin2PalTab, ",")

For i = 0 To UBound(arr1)               ' Подготовка данных - разворачивание таблиц перекодировки
    token = Split(Trim(arr1(i)), "-")
    Pin(i) = token(0)
    Pal(i) = token(1)
    PinToneI(i) = token(2)
    PalToneI(i) = token(3)
Next i

' Цикл обработки слов в выделенном фрагменте текста Word

For iWord = 1 To Selection.Words.Count

    Wp = Selection.Words(iWord)              ' Очередное слово пиньинь
    
    WpLen0 = Len(Wp)
    
    WpL = Trim(Wp)
    WpLen = Len(WpL)
    
    Blanks = ""                             ' Слово включает хвостовые пробелы - их сохраняем отдельно
    If WpLen <> WpLen0 Then
        Blanks = Right(Wp, WpLen0 - WpLen)
    End If
    
    WpL = LCase(Wp)                         ' К маленьким буквам
    UpperFirst = 0
    If Left(Wp, 1) <> Left(WpL, 1) Then
        UpperFirst = 1                      ' Первая буква была заглавная
    End If
    
    WpS = ""                                ' Удаление диакритики
    For i = 1 To WpLen
        Char1 = Mid(WpL, i, 1)
        Char1 = Decompose(Char1)
        WpS = WpS & Char1
    Next i
    
    For i = 0 To UBound(arr1)               ' Поиск пиньиня в таблице
        If WpS = Pin(i) Then
            Pinindex = i
            GoTo Found1
        End If
    Next i
   
    Result = Result & Wp                    ' Пиньинь не найден в таблице
    GoTo NextWord
    
Found1:
    Wr = Pal(Pinindex)                      ' Палладица
    ToneIP = PinToneI(Pinindex)             ' Номер буквы с тоном в пиньине
    ToneIr = PalToneI(Pinindex)             ' Номер буквы с тоном в палладице
    Char1 = Mid(WpL, ToneIP, 1)             ' Буква с тоном в тексте пиньиня (из маленьких букв)
    ToneN = Tone(Char1)                     ' Ее тон в пиньине
    
    If UpperFirst = 1 Then                  ' Заглавная если надо
        Palleft = Left(Wr, 1)
        PalRight = Right(Wr, Len(Wr) - 1)
        Palleft = UCase(Palleft)
        Wr = Palleft & PalRight
    End If
                                            ' Вставка тона в палладицу за буквой ToneIr
    Palleft = Left(Wr, ToneIr)
    PalRight = Right(Wr, Len(Wr) - ToneIr)
    If ToneN = 1 Then
        Palleft = Palleft & ChrW(769) ' 1
    ElseIf ToneN = 2 Then
        Palleft = Palleft & ChrW(772) ' 2
    ElseIf ToneN = 3 Then
        Palleft = Palleft & ChrW(780) ' 3
    ElseIf ToneN = 4 Then
        Palleft = Palleft & ChrW(768) ' 4
    End If
    W1 = Palleft & PalRight

    ' Добавление замененного слова
    Result = Result & W1 & Blanks

NextWord:
Next iWord

    ' Замена пиньиня на палладицу в выделеннром тексте Word
    Selection = Result

End Sub

' Функция удаления обозначения тона от буквы -------------------------------
Function Decompose(CharX As String)
Dim CharY As String
'fff = Hex(AscW(Mid(CharX, 1, 1)))
CharY = CharX

Select Case CharX
    Case ChrW(225)
        CharY = "a"
    Case ChrW(257)  ' a2
        CharY = "a"
    Case ChrW(462)  ' a3
        CharY = "a"
    Case ChrW(224)  ' a4
        CharY = "a"
    
    Case ChrW(233)  ' e1
        CharY = "e"
    Case ChrW(275)  ' e2
        CharY = "e"
    Case ChrW(283)  ' e3
        CharY = "e"
    Case ChrW(232)  ' e4
        CharY = "e"
    
    Case ChrW(237)  ' i1
        CharY = "i"
    Case ChrW(299)  ' i2
        CharY = "i"
    Case ChrW(464)  ' i3
        CharY = "i"
    Case ChrW(236)  ' i4
        CharY = "i"
    
    Case ChrW(243)  ' o1
        CharY = "o"
    Case ChrW(333)  ' o2
        CharY = "o"
    Case ChrW(466)  ' o3
        CharY = "o"
    Case ChrW(242)  ' o4
        CharY = "o"
    
    Case ChrW(250)  ' u1
        CharY = "u"
    Case ChrW(363)  ' u2
        CharY = "u"
    Case ChrW(468)  ' u3
        CharY = "u"
    Case ChrW(249)  ' u4
        CharY = "u"
        
    Case ChrW(472)  ' u1
        CharY = ChrW(252)
    Case ChrW(470)  ' u2
        CharY = ChrW(252)
    Case ChrW(474)  ' u3
        CharY = ChrW(252)
    Case ChrW(476)  ' u4
        CharY = ChrW(252)
        
End Select

Decompose = CharY

End Function

' Функция определения номера тона буквы ---------------------------
Function Tone(CharX As String)
Tone = 0

Select Case CharX
    Case ChrW(225)
        Tone = 1
    Case ChrW(257)  ' a2
        Tone = 2
    Case ChrW(462)  ' a3
        Tone = 3
    Case ChrW(224)  ' a4
        Tone = 4
    
    Case ChrW(233)  ' e1
        Tone = 1
    Case ChrW(275)  ' e2
        Tone = 2
    Case ChrW(283)  ' e3
        Tone = 3
    Case ChrW(232)  ' e4
        Tone = 4
    
    Case ChrW(237)  ' i1
        Tone = 1
    Case ChrW(299)  ' i2
        Tone = 2
    Case ChrW(464)  ' i3
        Tone = 3
    Case ChrW(236)  ' i4
        Tone = 4
    
    Case ChrW(243)  ' o1
        Tone = 1
    Case ChrW(333)  ' o2
        Tone = 2
    Case ChrW(466)  ' o3
        Tone = 3
    Case ChrW(242)  ' o4
        Tone = 4
    
    Case ChrW(250)  ' u1
        Tone = 1
    Case ChrW(363)  ' u2
        Tone = 2
    Case ChrW(468)  ' u3
        Tone = 3
    Case ChrW(249)  ' u4
        Tone = 4
        
    Case ChrW(472)  ' u1
        Tone = 1
    Case ChrW(470)  ' u2
        Tone = 2
    Case ChrW(474)  ' u3
        Tone = 3
    Case ChrW(476)  ' u4
        Tone = 4
End Select

End Function

' Функция подготовки таблицы преобразования ---------------------------
Sub PrepareTables(Pin2PalTab As String)

Pin2PalTab = "a-а-1-1, ai-ай-1-1, an-ань-1-1, ang-ан-1-1, ao-ао-1-1, "
Pin2PalTab = Pin2PalTab & "ba-ба-2-2, bai-бай-2-2, ban-бань-2-2, bang-бан-2-2, bao-бао-2-2, bei-бэй-2-2, ben-бэнь-2-2, beng-бэн-2-2, "
Pin2PalTab = Pin2PalTab & "bi-би-2-2, bian-бянь-3-2, biao-бяо-3-2, bie-бе-3-2, bin-бинь-2-2, bing-бин-2-2, bo-бо-2-2, bu-бу-2-2, "
Pin2PalTab = Pin2PalTab & "ca-ца-2-2, cai-цай-2-2, can-цань-2-2, cang-цан-2-2, cao-цао-2-2, ce-цэ-2-2, cei-цэй-2-2, cen-цэнь-2-2, "
Pin2PalTab = Pin2PalTab & "ceng-цэн-2-2, ci-цы-2-2, cong-цун-2-2, cou-цоу-2-2, cu-цу-2-2, cuan-цуань-3-3, cui-цуй-2-2, cun-цунь-2-2, cuo-цо-3-2, "
Pin2PalTab = Pin2PalTab & "cha-ча-3-2, chai-чай-3-2, chan-чань-3-2, chang-чан-3-2, chao-чао-3-2, che-чэ-3-2, chen-чэнь-3-2, cheng-чэн-3-2, "
Pin2PalTab = Pin2PalTab & "chi-чи-3-2, chong-чун-3-2, chou-чоу-3-2, chu-чу-3-2, chua-чуа-4-3, chuai-чуай-4-4, chuan-чуань-4-3, chuang-чуан-4-3, "
Pin2PalTab = Pin2PalTab & "chui-чуй-4-2, chun-чунь-3-2, chuo-чо-4-2, "
Pin2PalTab = Pin2PalTab & "da-да-2-2, dai-дай-2-2, dan-дань-2-2, dang-дан-2-2, dao-дао-2-2, de-дэ-2-2, dei-дэй-2-2, den-дэнь-2-2, "
Pin2PalTab = Pin2PalTab & "deng-дэн-2-2, di-ди-2-2, dia-дя-3-2, dian-дянь-3-2, diang-дян-3-2, diao-дяо-3-2, die-де-3-2, ding-дин-2-2, "
Pin2PalTab = Pin2PalTab & "diu-дю-3-2, dong-дун-2-2, dou-доу-2-2, du-ду-2-2, duan-дуань-3-2, dui-дуй-3-2, dun-дунь-2-2, duo-до-3-2, "
Pin2PalTab = Pin2PalTab & "e-э-1-1, ei-эй-1-1, en-энь-1-1, eng-эн-1-1, er-эр-1-1, "
Pin2PalTab = Pin2PalTab & "fa-фа-2-2, fan-фань-2-2, fang-фан-2-2, fei-фэй-2-2, fen-фэнь-2-2, feng-фэн-2-2, fiao-фяо-3-2, fo-фо-2-2, "
Pin2PalTab = Pin2PalTab & "fou-фоу-2-2, fu-фу-2-2, "
Pin2PalTab = Pin2PalTab & "ga-га-2-2, gai-гай-2-2, gan-гань-2-2, gang-ган-2-2, gao-гао-2-2, ge-гэ-2-2, gei-гэй-2-2, gen-гэнь-2-2, "
Pin2PalTab = Pin2PalTab & "geng-гэн-2-2, go-го-2-2, gong-гун-2-2, gou-гоу-2-2, gu-гу-2-2, gua-гуа-3-3, guai-гуай-3-3, guan-гуань-3-3, "
Pin2PalTab = Pin2PalTab & "guang-гуан-3-3, gui-гуй-3-2, gun-гунь-2-2, guo-го-3-2, "
Pin2PalTab = Pin2PalTab & "ha-ха-2-2, hai-хай-2-2, han-хань-2-2, hang-хан-2-2, hao-хао-2-2, he-хэ-2-2, hei-хэй-2-2, hen-хэнь-2-2, "
Pin2PalTab = Pin2PalTab & "heng-хэн-2-2, hm-хм-2-2, hng-хн-2-2, hong-хун-2-2, hou-хоу-2-2, hu-ху-2-2, hua-хуа-3-3, huai-хуай-3-3, "
Pin2PalTab = Pin2PalTab & "huan-хуань-3-3, huang-хуан-3-3, hui-хуэй-3-3, hun-хунь-2-2, huo-хо-3-2, "
Pin2PalTab = Pin2PalTab & "ji-цзи-2-3, jia-цзя-3-3, jian-цзянь-3-3, jiang-цзян-3-3, jiao-цзяо-3-3, jie-цзе-3-3, jin-цзинь-2-3, jing-цзин-2-3, "
Pin2PalTab = Pin2PalTab & "jiong-цзюн-3-3, jiu-цзю-3-3, ju-цзюй-2-3, juan-цзюань-3-4, jue-цзюэ-3-4, jun-цзюнь-2-3, "
Pin2PalTab = Pin2PalTab & "ka-ка-2-2, kai-кай-2-2, kan-кань-2-2, kang-кан-2-2, kao-као-2-2, ke-кэ-2-2, kei-кэй-2-2, ken-кэнь-2-2, "
Pin2PalTab = Pin2PalTab & "keng-кэн-2-2, kong-кун-2-2, kou-коу-2-2, ku-ку-2-2, kua-куа-3-3, kuai-куай-3-3, kuan-куань-3-3, kuang-куан-3-3, "
Pin2PalTab = Pin2PalTab & "kui-куй-3-2, kun-кунь-2-2, kuo-ко-3-2, "
Pin2PalTab = Pin2PalTab & "la-ла-2-2, lai-лай-2-2, lan-лань-2-2, lang-лан-2-2, lao-лао-2-2, le-лэ-2-2, lei-лэй-2-2, leng-лэн-2-2, "
Pin2PalTab = Pin2PalTab & "li-ли-2-2, lia-ля-3-2, lian-лянь-3-2, liang-лян-3-2, liao-ляо-3-2, lie-ле-3-2, lin-линь-2-2, ling-лин-2-2, "
Pin2PalTab = Pin2PalTab & "liu-лю-3-2, lo-ло-2-2, long-лун-2-2, lou-лоу-2-2, lu-лу-2-2, l" & ChrW(252) & "-люй-2-2, luan-луань-3-3, l" & ChrW(252) & "an-люань-3-3, "
Pin2PalTab = Pin2PalTab & "l" & ChrW(252) & "e-люэ-3-3, lun-лунь-2-2, l" & ChrW(252) & "n-люнь-2-2, luo-ло-3-2, "
Pin2PalTab = Pin2PalTab & "m-м-1-1, ma-ма-2-2, mai-май-2-2, man-мань-2-2, mang-ман-2-2, mao-мао-2-2, me-мэ-2-2, mei-мэй-2-2, "
Pin2PalTab = Pin2PalTab & "men-мэнь-2-2, meng-мэн-2-2, mi-ми-2-2, mian-мянь-3-2, miao-мяо-3-2, mie-ме-3-2, min-минь-2-2, ming-мин-2-2, "
Pin2PalTab = Pin2PalTab & "miu-мю-3-2, mm-мм-2-2, mo-мо-2-2, mou-моу-2-2, mu-му-2-2, "
Pin2PalTab = Pin2PalTab & "n-нь-1-1, na-на-2-2, nai-най-2-2, nan-нань-2-2, nang-нан-2-2, nao-нао-2-2, ne-нэ-2-2, nei-нэй-2-2, "
Pin2PalTab = Pin2PalTab & "nen-нэнь-2-2, neng-нэн-2-2, ng-н-1-1, ni-ни-2-2, nia-ня-3-2, nian-нянь-3-2, niang-нян-3-2, niao-няо-3-2, "
Pin2PalTab = Pin2PalTab & "nie-не-3-2, nin-нинь-2-2, ning-нин-2-2, niu-ню-3-2, nong-нун-2-2, nou-ноу-2-2, nu-ну-2-2, nun-нунь-2-2, "
Pin2PalTab = Pin2PalTab & "n" & ChrW(252) & "-нюй-2-2, nuan-нуань-3-3, n" & ChrW(252) & "e-нюэ-3-3, nuo-но-3-2, "
Pin2PalTab = Pin2PalTab & "o-о-1-1, ou-оу-1-1, "
Pin2PalTab = Pin2PalTab & "pa-па-2-2, pai-пай-2-2, pan-пань-2-2, pang-пан-2-2, pao-пао-2-2, pei-пэй-2-2, pen-пэнь-2-2, peng-пэн-2-2, "
Pin2PalTab = Pin2PalTab & "pi-пи-2-2, pian-пянь-3-2, piang-пян-3-2, piao-пяо-3-2, pie-пе-3-2, pin-пинь-2-2, ping-пин-2-2, po-по-2-2, "
Pin2PalTab = Pin2PalTab & "pou-поу-2-2, pu-пу-2-2, "
Pin2PalTab = Pin2PalTab & "qi-ци-2-2, qia-ця-3-2, qian-цянь-3-2, qiang-цян-3-2, qiao-цяо-3-2, qie-це-3-2, qin-цинь-2-2, qing-цин-2-2, "
Pin2PalTab = Pin2PalTab & "qiong-цюн-3-2, qiu-цю-3-2, qu-цюй-2-2, quan-цюань-3-3, que-цюэ-3-3, qun-цюнь-2-2, "
Pin2PalTab = Pin2PalTab & "ran-жань-2-2, rang-жан-2-2, rao-жао-2-2, re-жэ-2-2, rem-жэм-2-2, ren-жэнь-2-2, reng-жэн-2-2, ri-жи-2-2, "
Pin2PalTab = Pin2PalTab & "rong-жун-2-2, rou-жоу-2-2, ru-жу-2-2, rua-жуа-3-3, ruan-жуань-3-3, rui-жуй-3-2, run-жунь-2-2, ruo-жо-3-2, "
Pin2PalTab = Pin2PalTab & "sa-са-2-2, sai-сай-2-2, san-сань-2-2, sang-сан-2-2, sao-сао-2-2, se-сэ-2-2, sei-сэй-2-2, sen-сэнь-2-2, "
Pin2PalTab = Pin2PalTab & "seng-сэн-2-2, si-сы-2-2, song-сун-2-2, sou-соу-2-2, su-су-2-2, suan-суань-3-2, sui-суй-3-2, sun-сунь-2-2, suo-со-3-2, "
Pin2PalTab = Pin2PalTab & "sha-ша-3-2, shai-шай-3-2, shan-шань-3-2, shang-шан-3-2, shao-шао-3-2, she-шэ-3-2, shei-шэй-3-2, shen-шэнь-3-2, "
Pin2PalTab = Pin2PalTab & "sheng-шэн-3-2, shi-ши-3-2, shou-шоу-3-2, shu-шу-3-2, shua-шуа-4-4, shuai-шуай-4-3, shuan-шуань-4-3, shuang-шуан-4-3, "
Pin2PalTab = Pin2PalTab & "shui-шуй-4-2, shun-шунь-3-2, shuo-шо-4-2, "
Pin2PalTab = Pin2PalTab & "ta-та-2-2, tai-тай-2-2, tan-тань-2-2, tang-тан-2-2, tao-тао-2-2, te-тэ-2-2, tei-тэй-2-2, ten-тэнь-2-2, "
Pin2PalTab = Pin2PalTab & "teng-тэн-2-2, ti-ти-2-2, tian-тянь-3-2, tiang-тян-3-2, tiao-тяо-3-2, tie-те-3-2, ting-тин-2-2, tong-тун-2-2, "
Pin2PalTab = Pin2PalTab & "tou-тоу-2-2, tu-ту-2-2, tuan-туань-3-3, tui-туй-3-2, tun-тунь-2-2, tuo-то-3-2, "
Pin2PalTab = Pin2PalTab & "wa-ва-2-2, wai-вай-2-2, wan-вань-2-2, wang-ван-2-2, wao-вао-3-3, wei-вэй-2-2, wen-вэнь-2-2, weng-вэн-2-2, wo-во-2-2, wu-у-2-1, "
Pin2PalTab = Pin2PalTab & "xi-си-2-2, xia-ся-3-2, xian-сянь-3-2, xiang-сян-3-2, xiao-сяо-3-2, xie-се-3-2, xin-синь-2-2, xing-син-2-2, "
Pin2PalTab = Pin2PalTab & "xiong-сюн-3-2, xiu-сю-3-2, xu-сюй-2-2, xuan-сюань-3-3, xue-сюэ-3-3, xun-сюнь-2-2, "
Pin2PalTab = Pin2PalTab & "ya-я-2-1, yai-яй-2-1, yan-янь-2-1, yang-ян-2-1, yao-яо-2-1, ye-е-2-1, yi-и-2-1, yin-инь-2-1, "
Pin2PalTab = Pin2PalTab & "ying-ин-2-1, yo-ё-2-1, yong-юн-2-1, you-ю-2-1, yu-юй-2-1, yuan-юань-3-2, yue-юэ-3-2, yun-юнь-2-1, "
Pin2PalTab = Pin2PalTab & "za-цза-2-3, zai-цзай-2-3, zan-цзань-2-3, zang-цзан-2-3, zao-цзао-2-3, ze-цзэ-2-3, zei-цзэй-2-3, zem-цзэм-2-3, "
Pin2PalTab = Pin2PalTab & "zen-цзэнь-2-3, zeng-цзэн-2-3, zi-цзы-2-3, zong-цзун-2-3, zou-цзоу-2-3, zu-цзу-2-3, zuan-цзуань-3-4, zui-цзуй-3-3, zun-цзунь-2-3, zuo-цзо-3-3, "
Pin2PalTab = Pin2PalTab & "zha-чжа-3-3, zhai-чжай-3-3, zhan-чжань-3-3, zhang-чжан-3-3, zhao-чжао-3-3, zhe-чжэ-3-3, zhei-чжэй-3-3, zhen-чжэнь-3-3, "
Pin2PalTab = Pin2PalTab & "zheng-чжэн-3-3, zhi-чжи-3-3, zhong-чжун-3-3, zhou-чжоу-3-3, zhu-чжу-3-3, zhua-чжуа-4-4, zhuai-чжуай-4-4, zhuan-чжуань-4-4, "
Pin2PalTab = Pin2PalTab & "zhuang-чжуан-4-4, zhui-чжуй-4-3, zhun-чжунь-3-3, zhuo-чжо-4-3 "

End Sub