PDA

View Full Version : Tov MT/LXX Unicode Export?



rdtaylorjr
07-08-2011, 05:40 PM
This question has been asked before here (http://www.bibleworks.com/forums/showthread.php?4786-Simple-Parallel-Hebrew-and-LXX-(Tov-Polak)-Question&highlight=unicode+export), but it wasn't answered, and now I'm wondering the same thing.

Is there any way to export the parallel aligned MT/LXX database (or rather, part of it) in Unicode?

I see a way to copy selected lines, which is what I want, but when I go to paste them in word it uses the BibleWorks fonts rather than SBL Hebrew, which is my default export font.

By the way, I'm still using version 8. Any help would be greatly appreciated!

Michael Hanel
07-08-2011, 05:47 PM
I suppose no one answered it because they had no better answer. To my knowledge it's not possible to export it in Unicode. I imagine it could be possible some day, but it would have to be programmed to work that way. Since it's not in the normal Browse Window it doesn't seem to work the same way when you copy it.

Michael Hanel
07-09-2011, 04:25 PM
Here's a way to convert BW fonts to unicode once they're in Word. Maybe this will be of some aid.

In Word, open the view macros and then hit edit. That will bring you to the visual basic editor for macros. When you're there you want to copy the following text into the editor, but make sure you do it after a final End Sub with a solid line, otherwise you're adding this to the subroutine of an old macro. [[pasting this lost the formatting, but it should still work. if someone could verify it, I'd appreciate it]]

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
Selection.Delete
Application.Keyboard (1037)
With Selection.Font
.NameFarEast = "SimSun"
.NameAscii = "SBL Greek"
.NameOther = "SBL Greek"
.Name = "SBL Greek"
.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
Selection.Delete
Application.Keyboard (1032)
With Selection.Font
.NameFarEast = "SimSun"
.NameAscii = "SBL Greek"
.NameOther = "SBL Greek"
.Name = "SBL Greek"
.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
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
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 ConvertAllBwGrk2Unicode()
ConvertBwGrk2Unicode "bwgrkl", "SBL Greek", True
End Sub
Sub ConvertAllBwHeb2Unicode()
ConvertBwHeb2Unicode "bwhebb", "SBL Hebrew", True
End Sub
Sub ConvertAllBwLex2Unicode()
ConvertBwLex2Unicode "bwlexs", "SBL Greek", True
End Sub
Sub ConvertAllBwSym2Unicode()
ConvertBwSym2Unicode "bwsymbs", "SBL Greek", True
End Sub
Sub ConvertNextBwGrk2Unicode()
ConvertBwGrk2Unicode "bwgrkl", "SBL Greek", False
End Sub
Sub ConvertNextBwHeb2Unicode()
ConvertBwHeb2Unicode "bwhebb", "SBL Hebrew", False
End Sub
Sub ConvertNextBwLex2Unicode()
ConvertBwLex2Unicode "bwlexs", "SBL Greek", False
End Sub
Sub ConvertNextBwSym2Unicode()
ConvertBwSym2Unicode "bwsymbs", "SBL Greek", False
End Sub