Sub Espizo()
Rem *----*----* *----*----* *----*----* *----*----*
Rem エスペラント語 代用文字 範囲内置換処理
Rem 作譜：Hitrock Camellia Shinopy
Rem 言語：Word VBA
Rem 機能...
Rem エスペラント語代用文字を正書文字に置換する。
Rem エスペラント語正書文字を代用文字に置換する。
Rem 注記...
Rem 「Espizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する｡
Rem 不具合あり。
Rem EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。
Rem 履歴...
Rem 第01版：2004/12/12：作成。
Rem （...）
Rem 第10版：2007/01/06：Word2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。
Rem 第11版：2007/08/25：リストボックスをドロップダウンリストに変更。
Rem 第12版：2008/08/28：FaceIdを変更。（1611 => 1063）
Rem *----*----* *----*----* *----*----* *----*----*
Dim myTitle As String
Dim myBoolean As Boolean
Rem *----*----* *----*----* *----*----* *----*----*
'
Rem 既定値の設定
myTitle = "Espizo"
myBoolean = True ' アプリケーションの終了時に自動的にツールバー削除する。
Rem *----*----* *----*----* *----*----* *----*----*
'
Rem 同名ツールバーの削除
On Error Resume Next
CommandBars(myTitle).Delete
On Error GoTo 0
'
Rem ステータスバーの表示
Application.DisplayStatusBar = True
'
Call EspizoBlln(myTitle, myBoolean)
End Sub ' Espizo *----*----* *----*----* *----*----* *----*----*
Sub EspizoBlln(myTitle As String, myBoolean As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem ツールバー表示処理
Rem *----*----* *----*----* *----*----* *----*----*
Dim myCmmdBar As CommandBar
Dim myCtrlBttn As CommandBarControl
Dim myCtrlCboxItem As CommandBarControl
Rem *----*----* *----*----* *----*----* *----*----*
'
Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=myBoolean)
Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=myBoolean)
Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=myBoolean)
' Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=2, Temporary:=myBoolean)
Rem *----*----* *----*----* *----*----* *----*----*
'
With myCtrlBttn
.DescriptionText = "エスペラント語 代用文字 範囲内置換：選択した処理を実行します。"
.Style = msoButtonIcon
.Caption = myTitle
.TooltipText = "実行！"
.FaceId = 1063
.OnAction = "EspizoBttn"
End With
'
With myCtrlCboxItem
.DescriptionText = "実行する処理を選択します。"
.Style = msoComboNormal
.Caption = "処理"
'
.AddItem "^x記法", 1
.AddItem "^記法", 2
.AddItem "&;記法", 3
.AddItem "^’記法", 4
.AddItem "^h記法", 5
.AddItem "===========", 6
.AddItem "x代用表記", 7
.AddItem "^代用表記", 8
.AddItem "&;代用表記", 9
.AddItem "===========", 10
.AddItem "^接頭字記法", 11
'
.ListIndex = 1
.TooltipText = "^x記法"
.DropDownLines = 11
.DropDownWidth = 200
.OnAction = "EspizoCboxItem"
End With
'
myCmmdBar.Visible = True
End Sub ' EspizoBlln *----*----* *----*----* *----*----* *----*----*
Sub EspizoCboxItem(Optional myDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem [処理]コンボボックス処理
Rem *----*----* *----*----* *----*----* *----*----*
With CommandBars("Espizo").Controls(2)
If .Text = "===========" Then
.TooltipText = "処理が未選択です。"
Else
If .Text = "&;記法" Or .Text = "&;代用表記" Then
.TooltipText = "&" & .Text
Else
.TooltipText = .Text
End If
End If
End With
End Sub ' EspizoCboxItem *----*----* *----*----* *----*----* *----*----*
Sub EspizoBttn(Optional myDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 各ボタン処理
Rem *----*----* *----*----* *----*----* *----*----*
Dim myTitle As String
Dim myBttn As Long
Dim myLabel As String
Dim c As Long
Rem *----*----* *----*----* *----*----* *----*----*
'
myTitle = "Espizo"
'
With CommandBars(myTitle).Controls(2)
myLabel = .Text
myBttn = .ListIndex
End With
Rem *----*----* *----*----* *----*----* *----*----*
'
Select Case myBttn
Case 0, 6, 10
GoTo EspizoBttnSubExit
End Select
Rem *----*----* *----*----* *----*----* *----*----*
'
Application.ScreenUpdating = False
'
If Selection.Range.Text = "" Then
c = Selection.MoveUp(wdParagraph, 1, wdExtend)
If c = 0 Then
GoTo EspizoBttnSubExit
End If
End If
Rem *----*----* *----*----* *----*----* *----*----*
'
EspizoBttnSubEntry:
Select Case myBttn
Case 1
Call EspizoSffx("x")
Case 2
Call EspizoSffx("^")
Case 3
Call EspizoUcs2
Case 4
Call EspizoSffx("'")
Case 5
Call EspizoSffx("h")
Case 7
Call EspizoSuff("x")
Case 8
Call EspizoSuff("^")
Case 9
Call EspizoSuff("")
Case 11
Call EspizoPrfx("^") ' ^接頭字記法
End Select
Rem *----*----* *----*----* *----*----* *----*----*
'
EspizoBttnSubExit:
Selection.Collapse wdCollapseEnd
'
Rem 続けて処理する場合に備える。
CommandBars(myTitle).Enabled = False
CommandBars(myTitle).Enabled = True
'
Application.ScreenUpdating = True
'
Select Case myBttn
Case 1 To 5, 7 To 9, 11
Application.StatusBar = myTitle & "：" & "処理完了！" & "[ " & myLabel & " ]"
End Select
End Sub ' EspizoBttn *----*----* *----*----* *----*----* *----*----*
Sub EspizoSffx(mySffx As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 各接尾字記法処理
Rem mySffxの値...
Rem 「^」の場合：^接尾字付き文字を置換する。
Rem 「x」の場合：^接尾字付き文字・x接尾字付き文字ともに置換する。
Rem 「'」の場合：^接尾字付き文字・'接尾字付き文字ともに置換する。
Rem 「h」の場合：^接尾字付き文字・h接尾字付き文字ともに置換する。
Rem 注記...
Rem 参照設定する場合：Microsoft VBScript Regular Expressions 5.5
Rem *----*----* *----*----* *----*----* *----*----*
'
If Selection.Range.Characters.Count < 2 Then Exit Sub
'
Dim i As Long
Dim c As Integer
'
Dim myRange As Range
Dim myChrsFound As Characters
Dim myText As String
Dim myLen As Long
'
Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
Dim myMatches As Variant ' MatchCollection
Dim myMatch As Variant ' Match
Dim myPttn As String
'
Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
Set myRange = Selection.Range
Selection.Collapse wdCollapseStart
'
EspizoSffxSubEntry:
Rem パターンを設定
Select Case mySffx
Case "x"
myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[x\^]{1})"
Case "^"
myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\^]{1})"
Case "'"
myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\u0027\u2019\^]{1})"
Case "h"
myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[h\^]{1})"
End Select
'
With myRegExp
.Pattern = myPttn ' パターンを指定
.IgnoreCase = False ' 大文字小文字を区別する。
.Global = True ' 文字列全体を検索
End With
Set myMatches = myRegExp.Execute(myRange.Text)
'
If myMatches.Count = 0 Then GoTo EspizoSffxSubExit
'
With Selection.Find
For i = 0 To myMatches.Count - 1
.ClearFormatting
.Text = myMatches.Item(i).Value
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = False
.Execute
'
Set myChrsFound = Selection.Range.Characters
myText = myChrsFound.Parent.Text
myLen = Len(myText)
'
Select Case myChrsFound.First.Next.Text
Case "^"
Select Case myChrsFound.First.Text
Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
Call EspizoCghjsu("", "^", myText)
Case "A", "E", "I", "O", "a", "e", "i", "o"
Call EspizoAeiou("", "^", myText)
End Select
Case "x"
Select Case myChrsFound.First.Text
Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
Call EspizoCghjsu("", "x", myText)
End Select
Case "'", ChrW(8217) ' 単一引用符
Select Case myChrsFound.First.Text
Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
Call EspizoCghjsu("", "'", myText)
Call EspizoCghjsu("", ChrW(8217), myText)
End Select
Case "h"
Select Case myChrsFound.First.Text
Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
Call EspizoCghjsu("", "h", myText)
End Select
Case "_"
Select Case myChrsFound.First.Text
Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u"
Call EspizoAeiou("", "_", myText)
End Select
Case "~"
Select Case myChrsFound.First.Text
Case "U", "u"
Call EspizoCghjsu("", "^", myText)
End Select
End Select
'
If myLen <> Len(myText) Then
Rem 置換する文字列があった場合。
myChrsFound.First.Text = myText
myChrsFound.First.Next.Text = ""
End If
'
c = Int((i + 1) * 100 / myMatches.Count)
Application.StatusBar = "Espizo" & "：処理中" & " " & Format(c, "##0") & "%"
Next ' i
End With
'
EspizoSffxSubExit:
myRange.Select ' 当初の選択範囲。
Selection.Collapse wdCollapseEnd
'
Set myRegExp = Nothing
Set myMatches = Nothing
'
Set myRange = Nothing
Set myChrsFound = Nothing
End Sub ' EspizoSffx *----*----* *----*----* *----*----* *----*----*
Sub EspizoUcs2(Optional myDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 十進符号記法処理
Rem 「&〜;」（UCS_2十進符号表記）を検索し、文字列を置換する。
Rem 注記...
Rem 参照設定する場合：Microsoft VBScript Regular Expressions 5.5
Rem *----*----* *----*----* *----*----* *----*----*
'
If Selection.Range.Characters.Count < 3 Then Exit Sub
'
Dim i As Long
Dim j As Integer
Dim c As Integer
'
Dim myRange As Range
Dim myChrsFound As Characters
Dim myText As String
Dim myLen As Long
'
Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
Dim myMatches As Variant ' MatchCollection
Dim myMatch As Variant ' Match
'
Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
Set myRange = Selection.Range
Selection.Collapse wdCollapseStart
'
EspizoUcs2SubEntry:
With myRegExp
.Pattern = "\&{1}[\#A-Za-z0-9]{1,10}\;{1}" ' 「&〜;」を指定
.IgnoreCase = False ' 大文字小文字を区別する。
.Global = True ' 文字列全体を検索
End With
Set myMatches = myRegExp.Execute(myRange.Text)
'
If myMatches.Count = 0 Then GoTo EspizoUcs2SubExit
'
With Selection.Find
For i = 0 To myMatches.Count - 1
.ClearFormatting
.Text = myMatches.Item(i).Value
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = False
.Execute
'
Set myChrsFound = Selection.Range.Characters
myText = myChrsFound.Parent.Text
myLen = Len(myText)
'
Call EspizoUcAeiou(myText)
Call EspizoUcCghjsu(myText)
Call EspizoUcOthers(myText)
'
If myLen <> Len(myText) Then
Rem 置換する文字列があった場合。
Rem myChrsFound.Parent.Text = myText ' 不可！
Rem ↑文字列の最後に置換する文字がある場合、
Rem 処理後のカーソル位置がズレる。（↓苦肉の策！）
myChrsFound.First.Text = myText
For j = 2 To myLen
myChrsFound.First.Next.Text = ""
Next ' j
End If
'
c = Int((i + 1) * 100 / myMatches.Count)
Application.StatusBar = "Espizo" & "：処理中" & " " & Format(c, "##0") & "%"
Next ' i
End With
'
EspizoUcs2SubExit:
myRange.Select ' 当初の選択範囲。
Selection.Collapse wdCollapseEnd
'
Set myRegExp = Nothing
Set myMatches = Nothing
'
Set myRange = Nothing
Set myChrsFound = Nothing
End Sub ' EspizoUcs2 *----*----* *----*----* *----*----* *----*----*
Sub EspizoSuff(mySffx As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 代用文字表記処理
Rem 各国文字など各種の文字（Unicodeで160〜511の範囲）を検索し、
Rem (1)：検索した文字列を、UCS_2十進表記に置換する。
Rem (2)：エスペラント語文字を、指定した文字列接尾字付きの文字列に置換する。
Rem (3)：屈音符付き母音字は、「_」接尾字付き文字列に置換する。
Rem mySffxの値...
Rem 「」の場合：検索した総ての文字列を対象に(1)処理。
Rem 「^」の場合：(3)処理をし、(2)処理で「^」接尾字付きの文字列に置換する。
Rem 「x」の場合：(3)処理をし、(2)処理で「x」接尾字付きの文字列に置換する。
Rem 注記...
Rem 参照設定する場合：Microsoft VBScript Regular Expressions 5.5
Rem *----*----* *----*----* *----*----* *----*----*
'
If Selection.Range.Characters.Count < 1 Then Exit Sub
'
Dim i As Long
Dim c As Integer
'
Dim myRange As Range
Dim myChrsFound As Characters
Dim myText As String
Dim myLen As Long
'
Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
Dim myMatches As Variant ' MatchCollection
Dim myMatch As Variant ' Match
'
Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
Set myRange = Selection.Range
'
Selection.Collapse wdCollapseStart
'
EzpizoSuffSubEntry:
With myRegExp
.Pattern = "[" & ChrW(160) & "-" & ChrW(511) & "]{1}"
.IgnoreCase = False ' 大文字小文字を区別する。
.Global = True ' 文字列全体を検索
End With
Set myMatches = myRegExp.Execute(myRange.Text)
'
If myMatches.Count = 0 Then GoTo EzpizoSuffSubExit
'
With Selection.Find
For i = 0 To myMatches.Count - 1
.ClearFormatting
.Text = myMatches.Item(i).Value
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = False
.Execute
'
Set myChrsFound = Selection.Range.Characters
myText = myChrsFound.Parent.Text
myLen = Len(myText)
'
If mySffx = "" Then
Call EspizoRvOthers(myText)
Else
Select Case myText
Case ChrW(194), ChrW(202), ChrW(206), ChrW(212), ChrW(219)
Call EspizoRvAeiou("", "_", myText)
Case ChrW(226), ChrW(234), ChrW(238), ChrW(244), ChrW(251)
Call EspizoRvAeiou("", "_", myText)
Case ChrW(264), ChrW(284), ChrW(292), ChrW(308), ChrW(348), ChrW(364)
Call EspizoRvCghjsu("", mySffx, myText)
Case ChrW(265), ChrW(285), ChrW(293), ChrW(309), ChrW(349), ChrW(365)
Call EspizoRvCghjsu("", mySffx, myText)
Case Else
Call EspizoRvOthers(myText)
End Select
End If
'
If myLen <> Len(myText) Then
Rem 置換する文字列があった場合。
myChrsFound.Parent.Text = myText
End If
Call Selection.MoveRight(wdCharacter, Len(myText), wdMove)
'
c = Int((i + 1) * 100 / myMatches.Count)
Application.StatusBar = "Espizo" & "：処理中" & " " & Format(c, "##0") & "%"
Next ' i
End With
'
EzpizoSuffSubExit:
myRange.Select ' 当初の選択範囲。
Selection.Collapse wdCollapseEnd
'
Set myRegExp = Nothing
Set myMatches = Nothing
'
Set myRange = Nothing
Set myChrsFound = Nothing
End Sub ' EspizoSuff *----*----* *----*----* *----*----* *----*----*
Sub EspizoPrfx(myPrfx As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 各接頭尾字記法処理
Rem myPrfxの値...
Rem 「^」の場合：^接尾字付き文字を置換する。
Rem 注記...
Rem 参照設定する場合：Microsoft VBScript Regular Expressions 5.5
Rem *----*----* *----*----* *----*----* *----*----*
'
If Selection.Range.Characters.Count < 2 Then Exit Sub
'
Dim i As Long
Dim c As Integer
'
Dim myRange As Range
Dim myChrsFound As Characters
Dim myText As String
Dim myLen As Long
'
Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
Dim myMatches As Variant ' MatchCollection
Dim myMatch As Variant ' Match
Dim myPttn As String
'
Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
Set myRange = Selection.Range
Selection.Collapse wdCollapseStart
'
EspizoPrfxSubEntry:
Rem パターンを設定
Select Case myPrfx
Case "^"
myPttn = "([\_\^]{1}[AEIOaeio]{1})|([\_~]{1}[Uu]{1})|([\^]{1}[CGHJSUcghjsu]{1})"
End Select
'
With myRegExp
.Pattern = myPttn ' パターンを指定
.IgnoreCase = False ' 大文字小文字を区別する。
.Global = True ' 文字列全体を検索
End With
Set myMatches = myRegExp.Execute(myRange.Text)
'
If myMatches.Count = 0 Then GoTo EspizoPrfxSubExit
'
With Selection.Find
For i = 0 To myMatches.Count - 1
.ClearFormatting
If Left(myMatches.Item(i).Value, 1) = "^" Then
.Text = "^" & myMatches.Item(i).Value
Else
.Text = myMatches.Item(i).Value
End If
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = False
.Execute
'
Set myChrsFound = Selection.Range.Characters
myText = myChrsFound.Parent.Text
myLen = Len(myText)
'
Select Case myChrsFound.First.Text
Case "^"
Select Case myChrsFound.Last.Text
Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
Call EspizoCghjsu("^", "", myText)
Case "A", "E", "I", "O", "a", "e", "i", "o"
Call EspizoAeiou("^", "", myText)
End Select
Case "_"
Select Case myChrsFound.Last.Text
Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u"
Call EspizoAeiou("_", "", myText)
End Select
Case "~"
Select Case myChrsFound.Last.Text
Case "U", "u"
Call EspizoCghjsu("^", "", myText)
End Select
End Select
'
If myLen <> Len(myText) Then
Rem 置換する文字列があった場合。
myChrsFound.First.Text = myText
myChrsFound.First.Next.Text = ""
End If
'
c = Int((i + 1) * 100 / myMatches.Count)
Application.StatusBar = "Espizo" & "：処理中" & " " & Format(c, "##0") & "%"
Next ' i
End With
'
EspizoPrfxSubExit:
myRange.Select ' 当初の選択範囲。
Selection.Collapse wdCollapseEnd
'
Set myRegExp = Nothing
Set myMatches = Nothing
'
Set myRange = Nothing
Set myChrsFound = Nothing
End Sub ' EspizoPrfx *----*----* *----*----* *----*----* *----*----*
Sub EspizoAeiou(prefixC As String, suffixC As String, myText As String)
myText = Replace(myText, prefixC & "A" & suffixC, ChrW(194)) ' A^
myText = Replace(myText, prefixC & "E" & suffixC, ChrW(202)) ' E^
myText = Replace(myText, prefixC & "I" & suffixC, ChrW(206)) ' I^
myText = Replace(myText, prefixC & "O" & suffixC, ChrW(212)) ' O^
If prefixC = "" Then
myText = Replace(myText, "U_", ChrW(219)) ' U_
Else
myText = Replace(myText, "_U", ChrW(219)) ' U_
End If
'
myText = Replace(myText, prefixC & "a" & suffixC, ChrW(226)) ' a^
myText = Replace(myText, prefixC & "e" & suffixC, ChrW(234)) ' e^
myText = Replace(myText, prefixC & "i" & suffixC, ChrW(238)) ' i^
myText = Replace(myText, prefixC & "o" & suffixC, ChrW(244)) ' o^
If prefixC = "" Then
myText = Replace(myText, "u_", ChrW(251)) ' u_
Else
myText = Replace(myText, "_u", ChrW(251)) ' u_
End If
End Sub ' EspizoAeiou *----*----* *----*----* *----*----* *----*----*
Sub EspizoCghjsu(prefixC As String, suffixC As String, myText As String)
myText = Replace(myText, prefixC & "C" & suffixC, ChrW(264)) ' C^
myText = Replace(myText, prefixC & "G" & suffixC, ChrW(284)) ' G^
myText = Replace(myText, prefixC & "H" & suffixC, ChrW(292)) ' H^
myText = Replace(myText, prefixC & "J" & suffixC, ChrW(308)) ' J^
myText = Replace(myText, prefixC & "S" & suffixC, ChrW(348)) ' S^
If prefixC = "" Then
myText = Replace(myText, "U^", ChrW(364)) ' U^
myText = Replace(myText, "U~", ChrW(364)) ' U^
Select Case suffixC
Case "x"
myText = Replace(myText, "Ux", ChrW(364)) ' U^
Case "h"
myText = Replace(myText, "Uh", ChrW(364)) ' U^
Case "'"
myText = Replace(myText, "U'", ChrW(364)) ' U^
Case ChrW(8217)
myText = Replace(myText, "U" & ChrW(8217), ChrW(364)) ' U^
End Select
Else
myText = Replace(myText, "~U", ChrW(364)) ' U^
If Not (prefixC = "q" Or prefixC = "y") Then
myText = Replace(myText, prefixC & "U", ChrW(364)) ' U^
End If
Select Case prefixC
Case "x"
myText = Replace(myText, "xW", ChrW(364)) ' U^
Case "q"
myText = Replace(myText, "qW", ChrW(364)) ' U^
Case "y"
myText = Replace(myText, "yW", ChrW(364)) ' U^
End Select
End If
'
myText = Replace(myText, prefixC & "c" & suffixC, ChrW(265)) ' c^
myText = Replace(myText, prefixC & "g" & suffixC, ChrW(285)) ' g^
myText = Replace(myText, prefixC & "h" & suffixC, ChrW(293)) ' h^
myText = Replace(myText, prefixC & "j" & suffixC, ChrW(309)) ' j^
myText = Replace(myText, prefixC & "s" & suffixC, ChrW(349)) ' s^
If prefixC = "" Then
myText = Replace(myText, "u^", ChrW(365)) ' u^
myText = Replace(myText, "u~", ChrW(365)) ' u^
Select Case suffixC
Case "x"
myText = Replace(myText, "ux", ChrW(365)) ' u^
Case "h"
myText = Replace(myText, "uh", ChrW(365)) ' u^
Case "'"
myText = Replace(myText, "u'", ChrW(365)) ' U^
Case ChrW(8217)
myText = Replace(myText, "u" & ChrW(8217), ChrW(365)) ' U^
End Select
Else
myText = Replace(myText, "~u", ChrW(365)) ' u^
If Not (prefixC = "q" Or prefixC = "y") Then
myText = Replace(myText, prefixC & "u", ChrW(365)) ' u^
End If
Select Case prefixC
Case "x"
myText = Replace(myText, "xw", ChrW(365)) ' u^
Case "q"
myText = Replace(myText, "qw", ChrW(365)) ' u^
Case "y"
myText = Replace(myText, "yw", ChrW(365)) ' u^
End Select
End If
End Sub ' EspizoCghjsu *----*----* *----*----* *----*----* *----*----*
Sub EspizoUcAeiou(myText As String)
myText = Replace(myText, "Â", ChrW(194)) ' A_
myText = Replace(myText, "Ê", ChrW(202)) ' E_
myText = Replace(myText, "Î", ChrW(206)) ' I_
myText = Replace(myText, "Ô", ChrW(212)) ' O_
myText = Replace(myText, "Û", ChrW(219)) ' U_
'
myText = Replace(myText, "â", ChrW(226)) ' a_
myText = Replace(myText, "ê", ChrW(234)) ' e_
myText = Replace(myText, "î", ChrW(238)) ' i_
myText = Replace(myText, "ô", ChrW(244)) ' o_
myText = Replace(myText, "û", ChrW(251)) ' u_
End Sub ' EspizoUcAeiou *----*----* *----*----* *----*----* *----*----*
Sub EspizoUcCghjsu(myText As String)
Rem UTF
myText = Replace(myText, "Ĉ", ChrW(264)) ' C^
myText = Replace(myText, "Ĝ", ChrW(284)) ' G^
myText = Replace(myText, "Ĥ", ChrW(292)) ' H^
myText = Replace(myText, "Ĵ", ChrW(308)) ' J^
myText = Replace(myText, "Ŝ", ChrW(348)) ' S^
myText = Replace(myText, "Ŭ", ChrW(364)) ' U^
'
myText = Replace(myText, "ĉ", ChrW(265)) ' c^
myText = Replace(myText, "ĝ", ChrW(285)) ' g^
myText = Replace(myText, "ĥ", ChrW(293)) ' h^
myText = Replace(myText, "ĵ", ChrW(309)) ' j^
myText = Replace(myText, "ŝ", ChrW(349)) ' s^
myText = Replace(myText, "ŭ", ChrW(365)) ' u^
'
Exit Sub
Rem Latin-3
myText = Replace(myText, ChrW(198), ChrW(264)) ' C^
myText = Replace(myText, ChrW(216), ChrW(284)) ' G^
myText = Replace(myText, ChrW(166), ChrW(292)) ' H^
myText = Replace(myText, ChrW(172), ChrW(308)) ' J^
myText = Replace(myText, ChrW(222), ChrW(348)) ' S^
myText = Replace(myText, ChrW(221), ChrW(364)) ' U^
'
myText = Replace(myText, ChrW(230), ChrW(265)) ' c^
myText = Replace(myText, ChrW(248), ChrW(285)) ' g^
myText = Replace(myText, ChrW(182), ChrW(293)) ' h^
myText = Replace(myText, ChrW(188), ChrW(309)) ' j^
myText = Replace(myText, ChrW(254), ChrW(349)) ' s^
myText = Replace(myText, ChrW(253), ChrW(365)) ' u^
End Sub ' EspizoUcCghjsu *----*----* *----*----* *----*----* *----*----*
Sub EspizoUcOthers(myText As String)
Dim i As Integer
Rem
myText = Replace(myText, " ", ChrW(160))
myText = Replace(myText, "¡", ChrW(161))
myText = Replace(myText, "¢", ChrW(162))
myText = Replace(myText, "£", ChrW(163))
myText = Replace(myText, "¤", ChrW(164))
myText = Replace(myText, "¥", ChrW(165))
myText = Replace(myText, "¦", ChrW(166))
Rem
Rem
myText = Replace(myText, "©", ChrW(169))
myText = Replace(myText, "ª", ChrW(170))
myText = Replace(myText, "«", ChrW(171))
myText = Replace(myText, "¬", ChrW(172))
myText = Replace(myText, "­", ChrW(173))
myText = Replace(myText, "®", ChrW(174))
myText = Replace(myText, "¯", ChrW(175))
Rem
Rem
myText = Replace(myText, "²", ChrW(178))
myText = Replace(myText, "³", ChrW(179))
Rem
myText = Replace(myText, "µ", ChrW(181))
Rem
myText = Replace(myText, "·", ChrW(183))
myText = Replace(myText, "¸", ChrW(184))
myText = Replace(myText, "¹", ChrW(185))
myText = Replace(myText, "º", ChrW(186))
myText = Replace(myText, "»", ChrW(187))
myText = Replace(myText, "¼", ChrW(188))
myText = Replace(myText, "½", ChrW(189))
myText = Replace(myText, "¾", ChrW(190))
myText = Replace(myText, "¿", ChrW(191))
myText = Replace(myText, "À", ChrW(192))
myText = Replace(myText, "Á", ChrW(193))
myText = Replace(myText, "Â", ChrW(194))
myText = Replace(myText, "Ã", ChrW(195))
myText = Replace(myText, "Ä", ChrW(196))
myText = Replace(myText, "Å", ChrW(197))
myText = Replace(myText, "Æ", ChrW(198))
myText = Replace(myText, "Ç", ChrW(199))
myText = Replace(myText, "È", ChrW(200))
myText = Replace(myText, "É", ChrW(201))
myText = Replace(myText, "Ê", ChrW(202))
myText = Replace(myText, "Ë", ChrW(203))
myText = Replace(myText, "Ì", ChrW(204))
myText = Replace(myText, "Í", ChrW(205))
myText = Replace(myText, "Î", ChrW(206))
myText = Replace(myText, "Ï", ChrW(207))
myText = Replace(myText, "Ð", ChrW(208))
myText = Replace(myText, "Ñ", ChrW(209))
myText = Replace(myText, "Ò", ChrW(210))
myText = Replace(myText, "Ó", ChrW(211))
myText = Replace(myText, "Ô", ChrW(212))
myText = Replace(myText, "Õ", ChrW(213))
myText = Replace(myText, "Ö", ChrW(214))
Rem
myText = Replace(myText, "Ø", ChrW(216))
myText = Replace(myText, "Ù", ChrW(217))
myText = Replace(myText, "Ú", ChrW(218))
myText = Replace(myText, "Û", ChrW(219))
myText = Replace(myText, "Ü", ChrW(220))
myText = Replace(myText, "Ý", ChrW(221))
myText = Replace(myText, "Þ", ChrW(222))
myText = Replace(myText, "ß", ChrW(223))
myText = Replace(myText, "à", ChrW(224))
myText = Replace(myText, "á", ChrW(225))
myText = Replace(myText, "â", ChrW(226))
myText = Replace(myText, "ã", ChrW(227))
myText = Replace(myText, "ä", ChrW(228))
myText = Replace(myText, "å", ChrW(229))
myText = Replace(myText, "æ", ChrW(230))
myText = Replace(myText, "ç", ChrW(231))
myText = Replace(myText, "è", ChrW(232))
myText = Replace(myText, "é", ChrW(233))
myText = Replace(myText, "ê", ChrW(234))
myText = Replace(myText, "ë", ChrW(235))
myText = Replace(myText, "ì", ChrW(236))
myText = Replace(myText, "í", ChrW(237))
myText = Replace(myText, "î", ChrW(238))
myText = Replace(myText, "ï", ChrW(239))
myText = Replace(myText, "ð", ChrW(240))
myText = Replace(myText, "ñ", ChrW(241))
myText = Replace(myText, "ò", ChrW(242))
myText = Replace(myText, "ó", ChrW(243))
myText = Replace(myText, "ô", ChrW(244))
myText = Replace(myText, "õ", ChrW(245))
myText = Replace(myText, "ö", ChrW(246))
Rem
myText = Replace(myText, "ø", ChrW(248))
myText = Replace(myText, "ù", ChrW(249))
myText = Replace(myText, "ú", ChrW(250))
myText = Replace(myText, "û", ChrW(251))
myText = Replace(myText, "ü", ChrW(252))
myText = Replace(myText, "ý", ChrW(253))
myText = Replace(myText, "þ", ChrW(254))
myText = Replace(myText, "ÿ", ChrW(255))
'
For i = 256 To 511
myText = Replace(myText, "&#" & i & ";", ChrW(i))
Next ' i
End Sub ' EspizoUcOthers *----*----* *----*----* *----*----* *----*----*
Sub EspizoRvAeiou(prefixC As String, suffixC As String, myText As String)
myText = Replace(myText, ChrW(194), prefixC & "A" & suffixC) ' A^
myText = Replace(myText, ChrW(202), prefixC & "E" & suffixC) ' E^
myText = Replace(myText, ChrW(206), prefixC & "I" & suffixC) ' I^
myText = Replace(myText, ChrW(212), prefixC & "O" & suffixC) ' O^
If prefixC = "" Then
myText = Replace(myText, ChrW(219), "U_") ' U_
Else
myText = Replace(myText, ChrW(219), "_U") ' U_
End If
'
myText = Replace(myText, ChrW(226), prefixC & "a" & suffixC) ' a^
myText = Replace(myText, ChrW(234), prefixC & "e" & suffixC) ' e^
myText = Replace(myText, ChrW(238), prefixC & "i" & suffixC) ' i^
myText = Replace(myText, ChrW(244), prefixC & "o" & suffixC) ' o^
If prefixC = "" Then
myText = Replace(myText, ChrW(251), "u_") ' u_
Else
myText = Replace(myText, ChrW(251), "_u") ' u_
End If
End Sub ' EspizoRvAeiou *----*----* *----*----* *----*----* *----*----*
Sub EspizoRvCghjsu(prefixC As String, suffixC As String, myText As String)
myText = Replace(myText, ChrW(264), prefixC & "C" & suffixC) ' C^
myText = Replace(myText, ChrW(284), prefixC & "G" & suffixC) ' G^
myText = Replace(myText, ChrW(292), prefixC & "H" & suffixC) ' H^
myText = Replace(myText, ChrW(308), prefixC & "J" & suffixC) ' J^
myText = Replace(myText, ChrW(348), prefixC & "S" & suffixC) ' S^
If prefixC = "" Then
Select Case suffixC
Case "x"
myText = Replace(myText, ChrW(364), "Ux") ' U^
Case "h"
myText = Replace(myText, ChrW(364), "Uh") ' U^
Case Else
myText = Replace(myText, ChrW(364), "U^") ' U^
End Select
Else
If Not (prefixC = "q" Or prefixC = "y") Then
myText = Replace(myText, ChrW(364), "^U") ' U^
End If
Select Case prefixC
Case "x"
myText = Replace(myText, ChrW(364), "xW") ' U^
Case "q"
myText = Replace(myText, ChrW(364), "qW") ' U^
Case "y"
myText = Replace(myText, ChrW(364), "yW") ' U^
Case Else
myText = Replace(myText, ChrW(364), "^U") ' U^
End Select
End If
'
myText = Replace(myText, ChrW(265), prefixC & "c" & suffixC) ' c^
myText = Replace(myText, ChrW(285), prefixC & "g" & suffixC) ' g^
myText = Replace(myText, ChrW(293), prefixC & "h" & suffixC) ' h^
myText = Replace(myText, ChrW(309), prefixC & "j" & suffixC) ' j^
myText = Replace(myText, ChrW(349), prefixC & "s" & suffixC) ' s^
If prefixC = "" Then
Select Case suffixC
Case "x"
myText = Replace(myText, ChrW(365), "ux") ' u^
Case "h"
myText = Replace(myText, ChrW(365), "uh") ' u^
Case Else
myText = Replace(myText, ChrW(365), "u^") ' u^
End Select
Else
If Not (prefixC = "q" Or prefixC = "y") Then
myText = Replace(myText, ChrW(365), "^u") ' u^
End If
Select Case prefixC
Case "x"
myText = Replace(myText, ChrW(365), "xw") ' u^
Case "q"
myText = Replace(myText, ChrW(365), "qw") ' u^
Case "y"
myText = Replace(myText, ChrW(365), "yw") ' u^
Case Else
myText = Replace(myText, ChrW(365), "^u") ' u^
End Select
End If
End Sub ' EspizoRvCghjsu *----*----* *----*----* *----*----* *----*----*
Sub EspizoRvOthers(myText As String)
Dim i As Integer
Rem
myText = Replace(myText, ChrW(160), " ")
myText = Replace(myText, ChrW(161), "¡")
myText = Replace(myText, ChrW(162), "¢")
myText = Replace(myText, ChrW(163), "£")
myText = Replace(myText, ChrW(164), "¤")
myText = Replace(myText, ChrW(165), "¥")
myText = Replace(myText, ChrW(166), "¦")
Rem
Rem
myText = Replace(myText, ChrW(169), "©")
myText = Replace(myText, ChrW(170), "ª")
myText = Replace(myText, ChrW(171), "«")
myText = Replace(myText, ChrW(172), "¬")
myText = Replace(myText, ChrW(173), "­")
myText = Replace(myText, ChrW(174), "®")
myText = Replace(myText, ChrW(175), "¯")
Rem
Rem
myText = Replace(myText, ChrW(178), "²")
myText = Replace(myText, ChrW(179), "³")
Rem
myText = Replace(myText, ChrW(181), "µ")
Rem
myText = Replace(myText, ChrW(183), "·")
myText = Replace(myText, ChrW(184), "¸")
myText = Replace(myText, ChrW(185), "¹")
myText = Replace(myText, ChrW(186), "º")
myText = Replace(myText, ChrW(187), "»")
myText = Replace(myText, ChrW(188), "¼")
myText = Replace(myText, ChrW(189), "½")
myText = Replace(myText, ChrW(190), "¾")
myText = Replace(myText, ChrW(191), "¿")
myText = Replace(myText, ChrW(192), "À")
myText = Replace(myText, ChrW(193), "Á")
myText = Replace(myText, ChrW(194), "Â")
myText = Replace(myText, ChrW(195), "Ã")
myText = Replace(myText, ChrW(196), "Ä")
myText = Replace(myText, ChrW(197), "Å")
myText = Replace(myText, ChrW(198), "Æ")
myText = Replace(myText, ChrW(199), "Ç")
myText = Replace(myText, ChrW(200), "È")
myText = Replace(myText, ChrW(201), "É")
myText = Replace(myText, ChrW(202), "Ê")
myText = Replace(myText, ChrW(203), "Ë")
myText = Replace(myText, ChrW(204), "Ì")
myText = Replace(myText, ChrW(205), "Í")
myText = Replace(myText, ChrW(206), "Î")
myText = Replace(myText, ChrW(207), "Ï")
myText = Replace(myText, ChrW(208), "Ð")
myText = Replace(myText, ChrW(209), "Ñ")
myText = Replace(myText, ChrW(210), "Ò")
myText = Replace(myText, ChrW(211), "Ó")
myText = Replace(myText, ChrW(212), "Ô")
myText = Replace(myText, ChrW(213), "Õ")
myText = Replace(myText, ChrW(214), "Ö")
Rem
myText = Replace(myText, ChrW(216), "Ø")
myText = Replace(myText, ChrW(217), "Ù")
myText = Replace(myText, ChrW(218), "Ú")
myText = Replace(myText, ChrW(219), "Û")
myText = Replace(myText, ChrW(220), "Ü")
myText = Replace(myText, ChrW(221), "Ý")
myText = Replace(myText, ChrW(222), "Þ")
myText = Replace(myText, ChrW(223), "ß")
myText = Replace(myText, ChrW(224), "à")
myText = Replace(myText, ChrW(225), "á")
myText = Replace(myText, ChrW(226), "â")
myText = Replace(myText, ChrW(227), "ã")
myText = Replace(myText, ChrW(228), "ä")
myText = Replace(myText, ChrW(229), "å")
myText = Replace(myText, ChrW(230), "æ")
myText = Replace(myText, ChrW(231), "ç")
myText = Replace(myText, ChrW(232), "è")
myText = Replace(myText, ChrW(233), "é")
myText = Replace(myText, ChrW(234), "ê")
myText = Replace(myText, ChrW(235), "ë")
myText = Replace(myText, ChrW(236), "ì")
myText = Replace(myText, ChrW(237), "í")
myText = Replace(myText, ChrW(238), "î")
myText = Replace(myText, ChrW(239), "ï")
myText = Replace(myText, ChrW(240), "ð")
myText = Replace(myText, ChrW(241), "ñ")
myText = Replace(myText, ChrW(242), "ò")
myText = Replace(myText, ChrW(243), "ó")
myText = Replace(myText, ChrW(244), "ô")
myText = Replace(myText, ChrW(245), "õ")
myText = Replace(myText, ChrW(246), "ö")
Rem
myText = Replace(myText, ChrW(248), "ø")
myText = Replace(myText, ChrW(249), "ù")
myText = Replace(myText, ChrW(250), "ú")
myText = Replace(myText, ChrW(251), "û")
myText = Replace(myText, ChrW(252), "ü")
myText = Replace(myText, ChrW(253), "ý")
myText = Replace(myText, ChrW(254), "þ")
myText = Replace(myText, ChrW(255), "ÿ")
'
For i = 256 To 511
myText = Replace(myText, ChrW(i), "&#" & i & ";")
Next ' i
End Sub ' EspizoRvOthers *----*----* *----*----* *----*----* *----*----*
