0

Win98 を使用して、古いカザフ語フォント (カザフスタン) で書かれたドキュメントがあります。現在、Times New Roman を使用していますが、このフォントでは Unicode 文字が奇妙に表示されます。置換 (Ctrl + H) を使用してすべての記号を Times New Roman エンコーディングに変更できますが、文字数は 42 (どちらの場合も 84) です。

たとえば、最初の行に古いフォントのすべての記号があり、2 行目に新しいフォントのすべての記号が同じ順序で含まれています。

この 2 行を 1 文字ずつ読み取り、Java で辞書のようなものを作成し、グローバルな置換を行うサンプル スクリプトを誰かが作成できますか。

アップデート

ありがとうローマン・プリシュケ！

あるフォルダー内のすべての *.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
4

1 に答える 1

1

同様の変換にこのサブルーチンを使用しました。コードの「核心」は、文字列sTabの定義です。この文字列には、コード 127 以上のすべての文字が含まれます。この文字列に新しい文字を 1 つずつ入力します。

古いカザフ語コーディングのコード表がある場合、それは非常に簡単です。127 文字から始まるすべての文字を VBA エディターに入力します。VBA エディターは Unicode で動作するため、これで動作します。

コード表がない場合は、各文字の古いコードを取得し (この文字を選択して Alt+X を押してください)、文字列の正しい位置に手動で書き込む必要があります。

どちらの場合も、使用されていない (または異常な) 文字については、スペースまたは他の文字を埋めることができます。

残りのコードは、各文字をsTabからの新しい文字の 127 を超えるコードに置き換えます。

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
于 2013-11-11T12:25:53.833 に答える