Преобразование символов в MS Word

Question

У меня есть документы, написанные старым казахским шрифтом (Казахстан), используя win98. В настоящее время мы используем Times New Roman, но этот шрифт показывает странные символы Unicode. Я могу использовать подстановку (Ctrl + H), чтобы изменить все символы на кодировку Times New Roman, но у нас есть 42 (84 в обоих случаях) письма.

Например, у меня есть все символы из старого шрифта в первой строке и все символы из нового шрифта во второй строке в том же порядке.

Может ли кто-нибудь написать пример скрипта, который будет читать эти два символа строки char, делая что-то вроде словаря в Java, а затем выполняет глобальную замену.

Update

Спасибо Роман Плишке!

Я написал макрос, который рекурсивно применим ко всем файлам * .doc в некоторой папке.

Sub Substitution() 
' 
' Substitution of the chars from font Times/Kazakh 
' to Times New Roman 
' Chars to substitute are 176-255 bytes, 73 and 105 byte 
Dim sTab As String 
    sTab = "£ª½¥¡¯Ž¼º¾´¢¿žÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ" 
    Selection.Find.Font.Shadow = False 
    Selection.Find.Replacement.Font.Shadow = False 
    For i = 1 To Len(sTab) 
    With Selection.Find 
     .Text = ChrW(i + 175) 
     .Replacement.Text = Mid(sTab, i, 1) 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    Selection.Find.Text = Selection.Find.Text 
    Next i 
    Selection.Find.Execute Replace:=wdReplaceAll 
    With Selection.Find 
     .Text = ChrW(105) 
     .Replacement.Text = "³" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    Selection.Find.Text = Selection.Find.Text 

    With Selection.Find 
     .Text = ChrW(73) 
     .Replacement.Text = "²" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    Selection.Find.Text = Selection.Find.Text 

    ' kazakh language 
    Selection.WholeStory 
    Selection.LanguageID = WdLanguageID.wdKazakh 
    Application.CheckLanguage = False 
    Selection.Collapse Direction:=wdCollapseStart 
End Sub 

    ' Function that Call Substitution() for all documents 
    ' in folder vDirectory 
Sub LoopDirectory() 
    Dim vDirectory As String 
    Dim oDoc As Document 

    vDirectory = "E:\soft\Dedushka\not\" 

    vFile = Dir(vDirectory & "*.doc") 

    Do While vFile <> "" 
    Set oDoc = Documents.Open(FileName:=vDirectory & vFile) 

    Debug.Print ActiveDocument.Name + " Started" 
    Call Zamena 
    Debug.Print ActiveDocument.Name + " Finish" 

    oDoc.Close SaveChanges:=True 
    vFile = Dir 
    Loop 
End Sub 

Answer 1

Я использовал для подобных преобразований эту подпрограмму. «Сердцем» кода является определение строки sTab. Эта строка содержит все charactesr для кода 127 и выше. Заполните эту строку новыми символами один за другим.

Если у вас есть кодовая таблица старого казахского кодирования, это очень просто: введите в редакторе VBA все символы, начиная с 127 символов. Редактор VBA работает в Unicode, так что это работает.

Если у вас нет кодовой таблицы, вы должны получить старый код каждого символа (попробуйте выбрать этот символ и нажмите Alt + X) и записать его вручную в строке в правильном положении.

В обоих случаях для неиспользуемого (или необычно) символа вы можете заполнить пробел или другой символ.

Остальная часть кода заменяет каждый символ кодом выше 127 для нового символа от sTab.

Sub Convert() 
    Dim sTab As String 
    Dim sKod As String 
    Dim i As Long 
    Dim ch As String 

    'new chars 127-255: 
    'note: for each character above 127 fill in this table unicode character 
    sTab = "ÄÃãÉ¥ÖÜá¹ÈäèÆæéŸÏí“”ëEóeôöoúÌìü†°Ê£§•¶ß®©™ê¨‡gIlÎ__îK__³Ll¼¾ÅåNnѬVñÒ_«»… òÕOõO–—“”‘’÷_OÀàØ‹›øRrŠ‚„šŒœÁÍŽžUÓÔuÙÚùÛûUuÝýk¯£¿G¡" 

    'clear all shadow - we use this attrib as flag for changed characters 
    Selection.Find.ClearFormatting 
    Selection.Find.Font.Shadow = True 
    Selection.Find.replacement.ClearFormatting 
    Selection.Find.replacement.Font.Shadow = False 
    With Selection.Find 
     .Text = "" 
     .replacement.Text = "" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    'changing characters by codetable 
    Selection.Find.Font.Shadow = False 
    Selection.Find.replacement.Font.Shadow = True 
    For i = 1 To Len(sTab) 
     With Selection.Find 
      ch = Chr(126 + i) 
      If ch = "^" Then ch = "^^" 
      .Text = ch 
      ch = Mid(sTab, i, 1) 
      If ch = "^" Then ch = "^^" 
      .replacement.Text = ch 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = True 
      .MatchCase = True 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
     End With 
     Selection.Find.Execute Replace:=wdReplaceAll 
     Selection.Find.Text = Selection.Find.Text 
    Next i 
    'clear shadows 
    Selection.Find.Font.Shadow = True 
    Selection.Find.replacement.Font.Shadow = False 
    With Selection.Find 
     .Text = "" 
     .replacement.Text = "" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    ' kazakh language 
    Selection.WholeStory 
    Selection.LanguageID = WdLanguageID.wdKazakh 
    Application.CheckLanguage = False 
    Selection.Collapse Direction:=wdCollapseStart 
End Sub