Skip to content

Instantly share code, notes, and snippets.

@dspinellis

dspinellis/cp1250-to-cp1253.bas

Last active August 7, 2023 02:27
Download ZIP

Revisions

  1. dspinellis revised this gist Aug 6, 2023. 1 changed file with 5 additions and 5 deletions.
    10 changes: 5 additions & 5 deletions cp1250-to-cp1253.bas
    View file
    Original file line number Diff line number Diff line change
    @@ -17,19 +17,19 @@
    '
    ' Fix a Word 6.0 file, also known as Word 97-2003 or .doc file,
    ' where Greek characters are represented by the Unicode character of
    ' each cp-1250 (extended Latin) character residing on the same 8-bit position
    ' each cp-1250 (extended Latin) character residing in the same 8-bit position
    ' as the Greek character in cp-1253.
    ' (Originally this worked by having fonts that had Greek glyphs in the
    ' positions of the Latin glyphs.)
    '
    ' To use this program perform the following in Microsoft Word:
    ' - Press Alt+F11 to open the VBA editor.
    ' - In the VBA editor, select Insert -> Module to create a new module.
    ' - Paste the macro code into the module.
    ' - Paste this macro code into the module.
    ' - Close the VBA editor.
    ' - Press Alt+F8, select the macro (MultiReplace in this case), click "Run".
    ' - Press Alt+F8, select GreekFix, and click "Run".

    Sub MultiReplace()
    Sub GreekFix()
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .ClearFormatting
    @@ -41,7 +41,7 @@ Sub MultiReplace()
    For i = 184 To 254
    ReplaceOneChar ChrW(i), ChrW(i + 720)
    Next i
    ' In cp-1253 capital letter alpha with stress is in non-regular position,
    ' In cp-1253 capital letter alpha with stress has a non-regular position,
    ' because it clashed with the Word's paragraph mark.
    ReplaceOneChar ChrW(162), ChrW(902)
    End Sub
  2. dspinellis revised this gist Aug 5, 2023. No changes.
  3. dspinellis created this gist Aug 5, 2023.
    55 changes: 55 additions & 0 deletions cp1250-to-cp1253.bas
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,55 @@
    '
    ' Old Microsoft Word Greek document fixer
    '
    ' Copyright 2023 Diomidis Spinellis
    '
    ' Licensed under the Apache License, Version 2.0 (the "License");
    ' you may not use this file except in compliance with the License.
    ' You may obtain a copy of the License at
    '
    ' http://www.apache.org/licenses/LICENSE-2.0
    '
    ' Unless required by applicable law or agreed to in writing, software
    ' distributed under the License is distributed on an "AS IS" BASIS,
    ' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    ' See the License for the specific language governing permissions and
    ' limitations under the License.
    '
    ' Fix a Word 6.0 file, also known as Word 97-2003 or .doc file,
    ' where Greek characters are represented by the Unicode character of
    ' each cp-1250 (extended Latin) character residing on the same 8-bit position
    ' as the Greek character in cp-1253.
    ' (Originally this worked by having fonts that had Greek glyphs in the
    ' positions of the Latin glyphs.)
    '
    ' To use this program perform the following in Microsoft Word:
    ' - Press Alt+F11 to open the VBA editor.
    ' - In the VBA editor, select Insert -> Module to create a new module.
    ' - Paste the macro code into the module.
    ' - Close the VBA editor.
    ' - Press Alt+F8, select the macro (MultiReplace in this case), click "Run".

    Sub MultiReplace()
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchCase = True
    .Wrap = wdFindContinue
    End With
    ' Replace characters in the regular positions
    For i = 184 To 254
    ReplaceOneChar ChrW(i), ChrW(i + 720)
    Next i
    ' In cp-1253 capital letter alpha with stress is in non-regular position,
    ' because it clashed with the Word's paragraph mark.
    ReplaceOneChar ChrW(162), ChrW(902)
    End Sub

    Sub ReplaceOneChar(c1 As String, c2 As String)
    With Selection.Find
    .Text = c1
    .Replacement.Text = c2
    .Execute Replace:=wdReplaceAll
    End With
    End Sub