Sub Espizo()
Rem *----*----* *----*----* *----*----* *----*----*
Rem エスペラント語代用文字単葉内置換処理
Rem 作譜：Hitrock Camellia Shinopy
Rem 言語：PowerPoint VBA
Rem 機能...
Rem エスペラント語代用文字を正書文字に置換する。
Rem エスペラント語正書文字を代用文字に置換する。
Rem 注記...
Rem 「Espizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する｡
Rem 履歴...
Rem 第01版：2003/12/01：作成。
Rem （...）
Rem 第11版：2007/01/06：PowerPoint2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。
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
'
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)
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
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
Rem *----*----* *----*----* *----*----* *----*----*
'
EspizoBttnSubEntry:
Rem EspizoAeiouプロシージャをEspizoCghjsuプロシージャより
Rem 必ず先に処理を実行すること。
Rem （prefixC & "U/u" & suffixCを置換する都合による。）
Select Case myBttn
Case 1
Call EspizoShape("", "^", "Aeiou")
Call EspizoShape("", "_", "Aeiou")
Call EspizoShape("", "^", "Cghjsu")
Call EspizoShape("", "x", "Cghjsu")
Case 2
Call EspizoShape("", "^", "Aeiou")
Call EspizoShape("", "_", "Aeiou")
Call EspizoShape("", "^", "Cghjsu")
Case 3
Call EspizoShape("", "", "&;")
Case 4
Call EspizoShape("", "^", "Aeiou")
Call EspizoShape("", "_", "Aeiou")
Call EspizoShape("", "^", "Cghjsu")
Call EspizoShape("", "'", "Cghjsu")
Case 5
Call EspizoShape("", "^", "Aeiou")
Call EspizoShape("", "_", "Aeiou")
Call EspizoShape("", "^", "Cghjsu")
Call EspizoShape("", "h", "Cghjsu")
Case 7
Call EspizoShape("", "_", "RvAeiou")
Call EspizoShape("", "x", "RvCghjsu")
Call EspizoShape("", "", "Rv&;")
Case 8
Call EspizoShape("", "_", "RvAeiou")
Call EspizoShape("", "^", "RvCghjsu")
Call EspizoShape("", "", "Rv&;")
Case 9
Call EspizoShape("", "", "Rv&;")
Case 11
Call EspizoShape("^", "", "Aeiou")
Call EspizoShape("_", "", "Aeiou")
Call EspizoShape("^", "", "Cghjsu")
End Select
Rem *----*----* *----*----* *----*----* *----*----*
'
EspizoBttnSubExit:
Application.Activate
DoEvents: DoEvents: DoEvents
SendKeys "{ESC}", True
DoEvents: DoEvents: DoEvents
'
Rem 続けて処理する場合に備える。
CommandBars(myTitle).Enabled = False
CommandBars(myTitle).Enabled = True
'
' Application.ScreenUpdating = True
'
Select Case myBttn
Case 1 To 5, 7 To 9, 11
Rem Application.StatusBar = myTitle & "：" & "処理完了！" & "[ " & myLabel & " ]"
End Select
End Sub ' EspizoBttn *----*----* *----*----* *----*----* *----*----*
Sub EspizoShape(prefixC As String, suffixC As String, myFlag As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 描画オブジェクト別処理
Rem *----*----* *----*----* *----*----* *----*----*
Dim mySlideIndex As Long
Dim rr As Long
Dim cc As Long
Dim myText As String
Dim mySlide As Slide
Dim myShape As Shape
Rem *----*----* *----*----* *----*----* *----*----*
Rem 指定されたスライドのインデックス番号の取得
mySlideIndex = Application.ActiveWindow.Selection.SlideRange.SlideIndex
Set mySlide = Application.ActivePresentation.Slides(mySlideIndex)
Rem *----*----* *----*----* *----*----* *----*----*
'
Rem 描画オブジェクトの取得・文字列置換
For Each myShape In mySlide.Shapes
Rem 描画オブジェクトの代替テキストの文字列置換
myText = myShape.AlternativeText
Call EspizoConv(prefixC, suffixC, myFlag, myText)
myShape.AlternativeText = myText
'
Rem 描画オブジェクトの表示文字列置換
If myShape.HasTextFrame Then
myText = myShape.TextFrame.TextRange.Text
Call EspizoConv(prefixC, suffixC, myFlag, myText)
myShape.TextFrame.TextRange.Text = myText
Else
Select Case myShape.Type
Case msoTextEffect ' WordArt
myText = myShape.TextEffect.Text
Call EspizoConv(prefixC, suffixC, myFlag, myText)
myShape.TextEffect.Text = myText
Case msoTable ' 表
For rr = 1 To myShape.Table.Rows.Count
For cc = 1 To myShape.Table.Columns.Count
myText = myShape.Table.Cell(rr, cc).Shape.TextFrame.TextRange.Text
Call EspizoConv(prefixC, suffixC, myFlag, myText)
myShape.Table.Cell(rr, cc).Shape.TextFrame.TextRange.Text = myText
Next cc
Next rr
Case Else
Rem MsgBox "未対応 myShape.Type: " & myShape.Type
End Select
End If
Next myShape
Rem *----*----* *----*----* *----*----* *----*----*
'
Set mySlide = Nothing
End Sub ' EspizoShape ＊----＊----＊ ＊----＊----＊ ＊----＊----＊ ＊----＊----＊
Sub EspizoConv(prefixC As String, suffixC As String, myFlag As String, myText As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem 文字列置換処理
Rem *----*----* *----*----* *----*----* *----*----*
Select Case myFlag
Case "Aeiou"
Call EspizoAeiou(prefixC, suffixC, myText)
Case "Cghjsu"
Call EspizoCghjsu(prefixC, suffixC, myText)
Case "&;"
Call EspizoUcAeiou(myText)
Call EspizoUcCghjsu(myText)
Call EspizoUcOthers(myText)
Case "RvAeiou"
Call EspizoRvAeiou(prefixC, suffixC, myText)
Case "RvCghjsu"
Call EspizoRvCghjsu(prefixC, suffixC, myText)
Case "Rv&;"
Call EspizoRvOthers(myText)
End Select
End Sub ' EspizoConv ＊----＊----＊ ＊----＊----＊ ＊----＊----＊ ＊----＊----＊
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 *----*----* *----*----* *----*----* *----*----*
