Конвертирование старого текста?

Question

[Санжар Аубакиров]

Всем доброго времени суток!

Начну издалека. Мой дед профессор, пишет книги в MS Word на Win 98. Компьютер старый, казахский шрифт, которым он пользуется, тоже. В то время никто не знал что такое Unicode, развелось много казахских шрифтов с блэкджеком и т.д. Дед попросил меня перенести все книги на новый компьютер, т.к. на старом закончилось место, но там они открываются с кракозябрами. Хотелось бы конвертировать все его книги в новый Times New Roman, чтобы можно было легко их опубликовать в будущем. Можно было бы это сделать при помощи Ctrl + H.


Помогите написать макрос (для Office 2007 если это важно) который смог бы это сделать. Вот сслыка на папку где лежат те самые старые казахские шрифты и небольшой кусок одной из книг.

Задавал аналогичный вопрос на stackoverflow, возможно ответ, который мне дали, наведет кого-то на правильные мысли.

Comments

[demimurych]

А что происходит, если на старом дедовском компьютере выбрать стандартный ариал шрифт на этот текст?

[Санжар Аубакиров]

Я разобрался с тем что мне написали в stackoverflow таким образом:
1. Включил функцию запись макроса
2. Сделал замену через CTRL + H, буквы А кракозябры на букву А нормальную.
3. Остановил запись макроса.
4. Открыл макрсо в встроенном Editor и увидел вот такое чудо:

Sub Zamena()
'
' Zamena
'
'
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = ChrW(192)
            .Replacement.Text = "À"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Я понял что имел ввиду добрый человек на stackoverflow и написал вот это:

Sub Zamena()
'
' Zamena Ìàêðîñ
'
'
Dim sTab As String
    sTab = "£ª½¥¡¯Ž¼º¾´¢¿žÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
    Selection.Find.Execute Replace:=wdReplaceAll
    'changing characters by codetable
    Selection.Find.Font.Shadow = False
    Selection.Find.Replacement.Font.Shadow = True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    For i = 1 To Len(sTab)
        With Selection.Find
            .Text = ChrW(i + 175)
            .Replacement.Text = "À"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Find.Text = Selection.Find.Text
        Selection.Find.Execute
    Next i
End Sub

Где кракозябры это старые символы по таблице, начиная со 176 и заканчивая 255-м битом.

Теперь остался вопрос, как сделать чтобы Word меня не спрашивал, при замене каждой буквы, хочу ли я заменить все (Да \ Нет)

[Санжар Аубакиров]

Чтобы не спрашивал да\нет, нужно было поставить .Wrap =wdFindContinue вместо .Wrap = wdFindAsk

Также чтобы учитывался регистр нужно выставить .MatchCase = True

Конечный вариант выглядит вот так:

Sub Zamena()
'
' Zamena Макрос
'
'
Dim sTab As String
    sTab = "ӘҒҚҢӨҰҮҺәғқңөұүһАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
    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
    
    Selection.Find.Font.Shadow = False
    Selection.Find.Replacement.Font.Shadow = True
    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

Answer 1

[Санжар Аубакиров]

Рабочий вариант

Sub Zamena()
'
' Zamena Макрос
'
'
Dim sTab As String
    sTab = "ӘҒҚҢӨҰҮҺәғқңөұүһАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
    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
    
    Selection.Find.Font.Shadow = False
    Selection.Find.Replacement.Font.Shadow = True
    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

Answer 2

[ipswitch]

Можно установить на старый компьютер Adobe Acrobat 4.0 или 5.0, конвертировать всё в PDF. Сохранность будет «на века», и никаких проблем со шрифтами.
а новые книги писать уже иначе.

Comments

[Санжар Аубакиров]

Спасибо за совет. Но есть 2 книги которые он пишет сейчас, как минимум их нужно перекодировать.