BibleWorks Word 2003 Unicode Macros

bibleworksUnicodeMacros.bas

rem See comment below for information

Sub ConvertAllBwGrk2Unicode()
ConvertBwGrk2Unicode "bwgrkl", "Arial Unicode MS", True
End Sub

Sub ConvertAllBwHeb2Unicode()
ConvertBwHeb2Unicode "bwhebb", "SBL Hebrew", True
End Sub

Sub ConvertAllBwLex2Unicode()
ConvertBwLex2Unicode "bwlexs", "Arial Unicode MS", True
End Sub

Sub ConvertAllBwSym2Unicode()
ConvertBwSym2Unicode "bwsymbs", "Arial Unicode MS", True
End Sub

Sub ConvertNextBwGrk2Unicode()
ConvertBwGrk2Unicode "bwgrkl", "Arial Unicode MS", False
End Sub

Sub ConvertNextBwHeb2Unicode()
ConvertBwHeb2Unicode "bwhebb", "SBL Hebrew", False
End Sub

Sub ConvertNextBwLex2Unicode()
ConvertBwLex2Unicode "bwlexs", "Arial Unicode MS", False
End Sub

Sub ConvertNextBwSym2Unicode()
ConvertBwSym2Unicode "bwsymbs", "Arial Unicode MS", False
End Sub

rem The following are support routines for the previous subroutines.

    Sub ConvertBwHeb2Unicode(fromfont$, tofont$, doentirefile)
    Dim o As Object
    Dim ucstr As Variant
    ReDim ucstr(1024) As Long
    If (doentirefile = True) Then Selection.HomeKey Unit:=wdStory
    Set o = CreateObject("bibleworks.automation")
    Application.ScreenUpdating = True
    icheck = 0
    While (icheck = 0)
    Selection.Find.ClearFormatting
    With Selection.Find
        .Font.Name = fromfont$
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If (Selection.Find.Execute = False) Then
    icheck = 1
    Else
    istart = 1
    iend = Selection.Characters.Count
    ReDim ucstr(3 * iend + 2) As Long
    ucstr(1) = iend
    For i = istart To iend
    ucstr(i + 1) = Asc(Selection.Characters(i))
    Next i
    o.BwHebb2Unicode ucstr
    rem Selection.Delete
    Application.Keyboard (1037)
    With Selection.Font
        .NameFarEast = "SimSun"
        .NameAscii = "Arial"
        .NameOther = "Arial"
        .Name = "Arial"
        .Size = 10
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .DisableCharacterSpaceGrid = False
        .EmphasisMark = wdEmphasisMarkNone
        .SizeBi = 14
        .NameBi = tofont$
        .BoldBi = False
        .ItalicBi = False
    End With
    For i = 1 To ucstr(1)
    s$ = ChrW(ucstr(i + 1))
    Selection.TypeText Text:=s$
    Next i
    Application.Keyboard (1033)
    End If
    If (doentirefile = False) Then icheck = 1
    Wend
    Application.ScreenUpdating = True
    Set bwutil = Nothing
    End Sub


    Sub ConvertBwGrk2Unicode(fromfont$, tofont$, doentirefile)
    Dim o As Object
    Dim ucstr As Variant
    ReDim ucstr(1024) As Long
    If (doentirefile = True) Then Selection.HomeKey Unit:=wdStory
    Set o = CreateObject("bibleworks.automation")
    icheck = 0
    While (icheck = 0)
    Selection.Find.ClearFormatting
    With Selection.Find
        .Font.Name = fromfont$
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If (Selection.Find.Execute = False) Then
    icheck = 1
    Else
    istart = 1
    iend = Selection.Characters.Count
    ReDim ucstr(3 * iend + 2) As Long
    ucstr(1) = iend
    For i = istart To iend
    ucstr(i + 1) = Asc(Selection.Characters(i))
    Next i
    o.BwGrkl2Unicode ucstr
    rem Selection.Delete
    Application.Keyboard (1032)
    With Selection.Font
        .NameFarEast = "SimSun"
        .NameAscii = "Arial"
        .NameOther = "Arial"
        .Name = "Arial"
        .Size = 10
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .DisableCharacterSpaceGrid = False
        .EmphasisMark = wdEmphasisMarkNone
        .SizeBi = 14
        .NameBi = tofont$
        .BoldBi = False
        .ItalicBi = False
    End With
    For i = 1 To ucstr(1)
    s$ = ChrW(ucstr(i + 1))
    Selection.TypeText Text:=s$
    Next i
    Application.Keyboard (1033)
    End If
    If (doentirefile = False) Then icheck = 1
    Wend
    Set bwutil = Nothing
    End Sub


    Sub ConvertBwSym2Unicode(fromfont$, tofont$, doentirefile)
    Dim o As Object
    Dim ucstr As Variant
    ReDim ucstr(1024) As Long
    If (doentirefile = True) Then Selection.HomeKey Unit:=wdStory
    Set o = CreateObject("bibleworks.automation")
    icheck = 0
    While (icheck = 0)
    Selection.Find.ClearFormatting
    With Selection.Find
        .Font.Name = fromfont$
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If (Selection.Find.Execute = False) Then
    icheck = 1
    Else
    istart = 1
    iend = Selection.Characters.Count
    ReDim ucstr(3 * iend + 2) As Long
    ucstr(1) = iend
    For i = istart To iend
    ucstr(i + 1) = Asc(Selection.Characters(i))
    Next i
    o.BwSym2Unicode ucstr
    rem Selection.Delete
    Application.Keyboard (1033)
    With Selection.Font
        .NameFarEast = "SimSun"
        .NameAscii = tofont$
        .NameOther = tofont$
        .Name = tofont$
        .Size = 10
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .DisableCharacterSpaceGrid = False
        .EmphasisMark = wdEmphasisMarkNone
        .SizeBi = 12
        .NameBi = tofont$
        .BoldBi = False
        .ItalicBi = False
    End With
    For i = 1 To ucstr(1)
    isetsuper = 0
    If (ucstr(i + 1) < 0) Then
    Selection.Font.Superscript = True
    isetsuper = 1
    s$ = ChrW(-ucstr(i + 1))
    ElseIf (ucstr(i + 1) > 0) Then
    s$ = ChrW(ucstr(i + 1))
    Else
    s$ = " "
    End If
    Selection.TypeText Text:=s$
    If (isetsuper = 1) Then Selection.Font.Superscript = False
    Next i
    Application.Keyboard (1033)
    End If
    If (doentirefile = False) Then icheck = 1
    Wend
    Application.ScreenUpdating = True
    Set bwutil = Nothing
    End Sub


    Sub ConvertBwLex2Unicode(fromfont$, tofont$, doentirefile)
    Dim o As Object
    Dim ucstr As Variant
    ReDim ucstr(1024) As Long
    If (doentirefile = True) Then Selection.HomeKey Unit:=wdStory
    Set o = CreateObject("bibleworks.automation")
    icheck = 0
    While (icheck = 0)
    Selection.Find.ClearFormatting
    With Selection.Find
        .Font.Name = fromfont$
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    If (Selection.Find.Execute = False) Then
    icheck = 1
    Else
    istart = 1
    iend = Selection.Characters.Count
    ReDim ucstr(3 * iend + 2) As Long
    ucstr(1) = iend
    For i = istart To iend
    ucstr(i + 1) = Asc(Selection.Characters(i))
    Next i
    o.BwLex2Unicode ucstr
    rem Selection.Delete
    Application.Keyboard (1033)
    With Selection.Font
        .NameFarEast = "SimSun"
        .NameAscii = tofont$
        .NameOther = tofont$
        .Name = tofont$
        .Size = 10
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .DisableCharacterSpaceGrid = False
        .EmphasisMark = wdEmphasisMarkNone
        .SizeBi = 12
        .NameBi = tofont$
        .BoldBi = False
        .ItalicBi = False
    End With
    For i = 1 To ucstr(1)
    isetsuper = 0
    If (ucstr(i + 1) < 0) Then
    Selection.Font.Superscript = True
    isetsuper = 1
    s$ = ChrW(-ucstr(i + 1))
    ElseIf (ucstr(i + 1) > 0) Then
    s$ = ChrW(ucstr(i + 1))
    Else
    s$ = " "
    End If
    Selection.TypeText Text:=s$
    If (isetsuper = 1) Then Selection.Font.Superscript = False
    Next i
    Application.Keyboard (1033)
    End If
    If (doentirefile = False) Then icheck = 1
    Wend
    Application.ScreenUpdating = True
    Set bwutil = Nothing
    End Sub

From the BibleWorks help:

BibleWorks contains support internally for converting BibleWorks non-Unicode fonts to Unicode. If you have Word Documents which use BibleWorks non-Unicode fonts you can access the conversion routines through the following Word Macros. They have been tested only in Word 2003. To implement them just copy the blue text below into the Word Macro editor. If you want to use a different Unicode font you will need to edit the font names in the calling routines below. In other words, change "Ezra SIL" and "Arial Unicode MS" to the names of the fonts you want to use. BibleWorks ships with "SBL Greek" and "SBL Hebrew", as well as "Ezra SIL".