Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Sub Espizo() Rem *----*----* *----*----* *----*----* *----*----* Rem エスペラント語代用文字範囲内置換処理 Rem 作譜:Hitrock Camellia Shinopy Rem 言語:Excel VBA Rem 機能... Rem エスペラント語代用文字を正書文字に置換する。 Rem エスペラント語正書文字を代用文字に置換する。 Rem 注記... Rem 「Espizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する。 Rem 履歴... Rem 第01版:2002/11/30:作成。 Rem (...) Rem 第18版:2007/01/06:Excel2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。 Rem 第19版:2007/09/23:不具合を修正。 Rem 第20版:2008/08/28:FaceIdを変更。(1611 => 1063) Rem 第21版:2009/05/10:「打鍵起動」ボタンを追加。([Enter]キーで置換処理を起動) Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Rem *----*----* *----*----* *----*----* *----*----* ' Rem 既定値の設定 myTitle = "Espizo" Rem *----*----* *----*----* *----*----* *----*----* ' Rem 同名ツールバーの削除 On Error Resume Next CommandBars(myTitle).Delete On Error GoTo 0 ' Rem ステータスバーの表示 Application.DisplayStatusBar = True ' Call EspizoBlln(myTitle) End Sub ' Espizo *----*----* *----*----* *----*----* *----*----* Sub EspizoBlln(myTitle As String) Rem *----*----* *----*----* *----*----* *----*----* Rem ツールバー表示処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myCmmdBar As CommandBar Dim myCtrlAuto As CommandBarControl Dim myCtrlBttn As CommandBarControl Dim myCtrlCboxItem As CommandBarControl Rem *----*----* *----*----* *----*----* *----*----* ' Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True) Set myCtrlAuto = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True) Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True) Rem *----*----* *----*----* *----*----* *----*----* ' With myCtrlAuto .DescriptionText = "エスペラント語 代用文字 範囲内置換:選択した処理をキーを押して起動します。" .Style = msoButtonIcon .Caption = myTitle .TooltipText = "打鍵起動!" .FaceId = 6917 .OnAction = "EspizoAuto" End With ' 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(3) 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 EspizoAuto(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 自動実行ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* With CommandBars("Espizo").Controls(1) If .FaceId = 6917 Then .FaceId = 6914 .TooltipText = "打鍵起動 処理中。 実行:[Enter]キー 終了:[Esc]キー" Call EspizoAutoLoop("Espizo") Else .FaceId = 6917 .TooltipText = "打鍵起動!" End If End With End Sub ' EspizoAuto *----*----* *----*----* *----*----* *----*----* Sub EspizoBttn(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 各ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Dim myBttn As Long Dim myLabel As String Rem *----*----* *----*----* *----*----* *----*----* ' Dim Addr As String Dim AddrEnd As String Dim RowNo As Long Dim ColNo As Long Rem *----*----* *----*----* *----*----* *----*----* ' myTitle = "Espizo" ' With CommandBars(myTitle).Controls(3) myLabel = .Text myBttn = .ListIndex End With Rem *----*----* *----*----* *----*----* *----*----* ' Select Case myBttn Case 0, 6, 10 GoTo EspizoBttnSubExit End Select Rem *----*----* *----*----* *----*----* *----*----* ' Application.ScreenUpdating = False ' If Selection.Cells.Count = 1 Then If Selection.Cells.Text = "" Then ActiveSheet.UsedRange.Select End If End If Addr = ActiveWindow.Selection.Address(False, False) Rem 末尾セルの取得 AddrEnd = Replace(Addr, ",", ":") AddrEnd = Mid(AddrEnd, InStrRev(AddrEnd, ":") + 1) Rem *----*----* *----*----* *----*----* *----*----* ' EspizoBttnSubEntry: Rem EspizoAeiouプロシージャをEspizoCghjsuプロシージャより Rem 必ず先に処理を実行すること。 Rem (prefixC & "U/u" & suffixCを置換する都合による。) Select Case myBttn Case 1 Call EspizoCell("", "^", "Aeiou") Call EspizoCell("", "_", "Aeiou") Call EspizoCell("", "^", "Cghjsu") Call EspizoCell("", "x", "Cghjsu") Case 2 Call EspizoCell("", "^", "Aeiou") Call EspizoCell("", "_", "Aeiou") Call EspizoCell("", "^", "Cghjsu") Case 3 Call EspizoCell("", "", "&;") Case 4 Call EspizoCell("", "^", "Aeiou") Call EspizoCell("", "_", "Aeiou") Call EspizoCell("", "^", "Cghjsu") Call EspizoCell("", "'", "Cghjsu") Case 5 Call EspizoCell("", "^", "Aeiou") Call EspizoCell("", "_", "Aeiou") Call EspizoCell("", "^", "Cghjsu") Call EspizoCell("", "h", "Cghjsu") Case 7 Call EspizoCell("", "_", "RvAeiou") Call EspizoCell("", "x", "RvCghjsu") Call EspizoCell("", "", "Rv&;") Case 8 Call EspizoCell("", "_", "RvAeiou") Call EspizoCell("", "^", "RvCghjsu") Call EspizoCell("", "", "Rv&;") Case 9 Call EspizoCell("", "", "Rv&;") Case 11 Call EspizoCell("^", "", "Aeiou") Call EspizoCell("_", "", "Aeiou") Call EspizoCell("^", "", "Cghjsu") End Select ' Range(AddrEnd).Select ' 末尾セルの選択 With Range(AddrEnd) RowNo = .Row ColNo = .Column End With Select Case Application.MoveAfterReturnDirection Case xlDown Cells(RowNo + 1, ColNo).Select ' 下隣セル Case xlToRight Cells(RowNo, ColNo + 1).Select ' 右隣セル Case xlUp If RowNo > 1 Then RowNo = RowNo - 1 End If Cells(RowNo, ColNo).Select ' 上隣セル Case xlToLeft If ColNo > 1 Then ColNo = ColNo - 1 End If Cells(RowNo, ColNo).Select ' 左隣セル End Select Rem *----*----* *----*----* *----*----* *----*----* ' EspizoBttnSubExit: Rem 続けて処理する場合に備える。(〜Excel 2003) If Val(Application.Version) < 12 Then CommandBars(myTitle).Enabled = False CommandBars(myTitle).Enabled = True End If ' Application.ScreenUpdating = True ' Select Case myBttn Case 1 To 5, 7 To 9, 11 Application.StatusBar = myTitle & ":" & "処理完了!" & "[ " & myLabel & " ]" End Select End Sub ' EspizoBttn *----*----* *----*----* *----*----* *----*----* Sub EspizoAutoLoop(myTitle As String) Dim myAddress As String ' Do If CommandBars(myTitle).Controls(1).FaceId = 6917 Then Exit Do ' Select Case True Case GetAsyncKeyState(vbKeyReturn) <> 0 DoEvents If Selection.Cells.Count = 1 Then Rem 単一セルを選択している場合だけ処理 CommandBars(myTitle).Controls(1).FaceId = 2151 Application.ScreenUpdating = False myAddress = ActiveCell.Cells.Address ' On Error Resume Next Select Case Application.MoveAfterReturnDirection Case xlDown Range(myAddress).Offset(-1, 0).Select ' 上隣セル Case xlToRight Range(myAddress).Offset(0, -1).Select ' 左隣セル Case xlUp If ActiveCell.Cells.Row <> 1 Then Range(myAddress).Offset(1, 0).Select ' 下隣セル End If Case xlToLeft If ActiveCell.Cells.Column <> 1 Then Range(myAddress).Offset(0, 1).Select ' 右隣セル End If End Select On Error GoTo 0 ' Call EspizoBttn Range(myAddress).Select Application.ScreenUpdating = True CommandBars(myTitle).Controls(1).FaceId = 6914 End If Case GetAsyncKeyState(vbKeyEscape) <> 0 DoEvents CommandBars(myTitle).Controls(1).FaceId = 6917 CommandBars(myTitle).Controls(1).TooltipText = "打鍵起動!" Exit Do End Select ' DoEvents Loop End Sub ' EspizoAutoLoop *----*----* *----*----* *----*----* *----*----* Sub EspizoCell(prefixC As String, suffixC As String, myFlag As String) Dim myCell As Range Dim myText As String ' For Each myCell In Selection myText = myCell.Text 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 myCell.Value2 = myText Next myCell End Sub ' EspizoCell *----*----* *----*----* *----*----* *----*----* 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, "&Acirc;", ChrW(194)) ' A_ myText = Replace(myText, "&Ecirc;", ChrW(202)) ' E_ myText = Replace(myText, "&Icirc;", ChrW(206)) ' I_ myText = Replace(myText, "&Ocirc;", ChrW(212)) ' O_ myText = Replace(myText, "&Ucirc;", ChrW(219)) ' U_ ' myText = Replace(myText, "&acirc;", ChrW(226)) ' a_ myText = Replace(myText, "&ecirc;", ChrW(234)) ' e_ myText = Replace(myText, "&icirc;", ChrW(238)) ' i_ myText = Replace(myText, "&ocirc;", ChrW(244)) ' o_ myText = Replace(myText, "&ucirc;", ChrW(251)) ' u_ End Sub ' EspizoUcAeiou *----*----* *----*----* *----*----* *----*----* Sub EspizoUcCghjsu(myText As String) Rem UTF myText = Replace(myText, "&#264;", ChrW(264)) ' C^ myText = Replace(myText, "&#284;", ChrW(284)) ' G^ myText = Replace(myText, "&#292;", ChrW(292)) ' H^ myText = Replace(myText, "&#308;", ChrW(308)) ' J^ myText = Replace(myText, "&#348;", ChrW(348)) ' S^ myText = Replace(myText, "&#364;", ChrW(364)) ' U^ ' myText = Replace(myText, "&#265;", ChrW(265)) ' c^ myText = Replace(myText, "&#285;", ChrW(285)) ' g^ myText = Replace(myText, "&#293;", ChrW(293)) ' h^ myText = Replace(myText, "&#309;", ChrW(309)) ' j^ myText = Replace(myText, "&#349;", ChrW(349)) ' s^ myText = Replace(myText, "&#365;", 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, "&nbsp;", ChrW(160)) myText = Replace(myText, "&iexcl;", ChrW(161)) myText = Replace(myText, "&cent;", ChrW(162)) myText = Replace(myText, "&pound;", ChrW(163)) myText = Replace(myText, "&curren;", ChrW(164)) myText = Replace(myText, "&yen;", ChrW(165)) myText = Replace(myText, "&brvbar;", ChrW(166)) Rem Rem myText = Replace(myText, "&copy;", ChrW(169)) myText = Replace(myText, "&ordf;", ChrW(170)) myText = Replace(myText, "&laquo;", ChrW(171)) myText = Replace(myText, "&not;", ChrW(172)) myText = Replace(myText, "&shy;", ChrW(173)) myText = Replace(myText, "&reg;", ChrW(174)) myText = Replace(myText, "&macr;", ChrW(175)) Rem Rem myText = Replace(myText, "&sup2;", ChrW(178)) myText = Replace(myText, "&sup3;", ChrW(179)) Rem myText = Replace(myText, "&micro;", ChrW(181)) Rem myText = Replace(myText, "&middot;", ChrW(183)) myText = Replace(myText, "&cedil;", ChrW(184)) myText = Replace(myText, "&sup1;", ChrW(185)) myText = Replace(myText, "&ordm;", ChrW(186)) myText = Replace(myText, "&raquo;", ChrW(187)) myText = Replace(myText, "&frac14;", ChrW(188)) myText = Replace(myText, "&frac12;", ChrW(189)) myText = Replace(myText, "&frac34;", ChrW(190)) myText = Replace(myText, "&iquest;", ChrW(191)) myText = Replace(myText, "&Agrave;", ChrW(192)) myText = Replace(myText, "&Aacute;", ChrW(193)) myText = Replace(myText, "&Acirc;", ChrW(194)) myText = Replace(myText, "&Atilde;", ChrW(195)) myText = Replace(myText, "&Auml;", ChrW(196)) myText = Replace(myText, "&Aring;", ChrW(197)) myText = Replace(myText, "&AElig;", ChrW(198)) myText = Replace(myText, "&Ccedil;", ChrW(199)) myText = Replace(myText, "&Egrave;", ChrW(200)) myText = Replace(myText, "&Eacute;", ChrW(201)) myText = Replace(myText, "&Ecirc;", ChrW(202)) myText = Replace(myText, "&Euml;", ChrW(203)) myText = Replace(myText, "&Igrave;", ChrW(204)) myText = Replace(myText, "&Iacute;", ChrW(205)) myText = Replace(myText, "&Icirc;", ChrW(206)) myText = Replace(myText, "&Iuml;", ChrW(207)) myText = Replace(myText, "&ETH;", ChrW(208)) myText = Replace(myText, "&Ntilde;", ChrW(209)) myText = Replace(myText, "&Ograve;", ChrW(210)) myText = Replace(myText, "&Oacute;", ChrW(211)) myText = Replace(myText, "&Ocirc;", ChrW(212)) myText = Replace(myText, "&Otilde;", ChrW(213)) myText = Replace(myText, "&Ouml;", ChrW(214)) Rem myText = Replace(myText, "&Oslash;", ChrW(216)) myText = Replace(myText, "&Ugrave;", ChrW(217)) myText = Replace(myText, "&Uacute;", ChrW(218)) myText = Replace(myText, "&Ucirc;", ChrW(219)) myText = Replace(myText, "&Uuml;", ChrW(220)) myText = Replace(myText, "&Yacute;", ChrW(221)) myText = Replace(myText, "&THORN;", ChrW(222)) myText = Replace(myText, "&szlig;", ChrW(223)) myText = Replace(myText, "&agrave;", ChrW(224)) myText = Replace(myText, "&aacute;", ChrW(225)) myText = Replace(myText, "&acirc;", ChrW(226)) myText = Replace(myText, "&atilde;", ChrW(227)) myText = Replace(myText, "&auml;", ChrW(228)) myText = Replace(myText, "&aring;", ChrW(229)) myText = Replace(myText, "&aelig;", ChrW(230)) myText = Replace(myText, "&ccedil;", ChrW(231)) myText = Replace(myText, "&egrave;", ChrW(232)) myText = Replace(myText, "&eacute;", ChrW(233)) myText = Replace(myText, "&ecirc;", ChrW(234)) myText = Replace(myText, "&euml;", ChrW(235)) myText = Replace(myText, "&igrave;", ChrW(236)) myText = Replace(myText, "&iacute;", ChrW(237)) myText = Replace(myText, "&icirc;", ChrW(238)) myText = Replace(myText, "&iuml;", ChrW(239)) myText = Replace(myText, "&eth;", ChrW(240)) myText = Replace(myText, "&ntilde;", ChrW(241)) myText = Replace(myText, "&ograve;", ChrW(242)) myText = Replace(myText, "&oacute;", ChrW(243)) myText = Replace(myText, "&ocirc;", ChrW(244)) myText = Replace(myText, "&otilde;", ChrW(245)) myText = Replace(myText, "&ouml;", ChrW(246)) Rem myText = Replace(myText, "&oslash;", ChrW(248)) myText = Replace(myText, "&ugrave;", ChrW(249)) myText = Replace(myText, "&uacute;", ChrW(250)) myText = Replace(myText, "&ucirc;", ChrW(251)) myText = Replace(myText, "&uuml;", ChrW(252)) myText = Replace(myText, "&yacute;", ChrW(253)) myText = Replace(myText, "&thorn;", ChrW(254)) myText = Replace(myText, "&yuml;", 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), "&nbsp;") myText = Replace(myText, ChrW(161), "&iexcl;") myText = Replace(myText, ChrW(162), "&cent;") myText = Replace(myText, ChrW(163), "&pound;") myText = Replace(myText, ChrW(164), "&curren;") myText = Replace(myText, ChrW(165), "&yen;") myText = Replace(myText, ChrW(166), "&brvbar;") Rem Rem myText = Replace(myText, ChrW(169), "&copy;") myText = Replace(myText, ChrW(170), "&ordf;") myText = Replace(myText, ChrW(171), "&laquo;") myText = Replace(myText, ChrW(172), "&not;") myText = Replace(myText, ChrW(173), "&shy;") myText = Replace(myText, ChrW(174), "&reg;") myText = Replace(myText, ChrW(175), "&macr;") Rem Rem myText = Replace(myText, ChrW(178), "&sup2;") myText = Replace(myText, ChrW(179), "&sup3;") Rem myText = Replace(myText, ChrW(181), "&micro;") Rem myText = Replace(myText, ChrW(183), "&middot;") myText = Replace(myText, ChrW(184), "&cedil;") myText = Replace(myText, ChrW(185), "&sup1;") myText = Replace(myText, ChrW(186), "&ordm;") myText = Replace(myText, ChrW(187), "&raquo;") myText = Replace(myText, ChrW(188), "&frac14;") myText = Replace(myText, ChrW(189), "&frac12;") myText = Replace(myText, ChrW(190), "&frac34;") myText = Replace(myText, ChrW(191), "&iquest;") myText = Replace(myText, ChrW(192), "&Agrave;") myText = Replace(myText, ChrW(193), "&Aacute;") myText = Replace(myText, ChrW(194), "&Acirc;") myText = Replace(myText, ChrW(195), "&Atilde;") myText = Replace(myText, ChrW(196), "&Auml;") myText = Replace(myText, ChrW(197), "&Aring;") myText = Replace(myText, ChrW(198), "&AElig;") myText = Replace(myText, ChrW(199), "&Ccedil;") myText = Replace(myText, ChrW(200), "&Egrave;") myText = Replace(myText, ChrW(201), "&Eacute;") myText = Replace(myText, ChrW(202), "&Ecirc;") myText = Replace(myText, ChrW(203), "&Euml;") myText = Replace(myText, ChrW(204), "&Igrave;") myText = Replace(myText, ChrW(205), "&Iacute;") myText = Replace(myText, ChrW(206), "&Icirc;") myText = Replace(myText, ChrW(207), "&Iuml;") myText = Replace(myText, ChrW(208), "&ETH;") myText = Replace(myText, ChrW(209), "&Ntilde;") myText = Replace(myText, ChrW(210), "&Ograve;") myText = Replace(myText, ChrW(211), "&Oacute;") myText = Replace(myText, ChrW(212), "&Ocirc;") myText = Replace(myText, ChrW(213), "&Otilde;") myText = Replace(myText, ChrW(214), "&Ouml;") Rem myText = Replace(myText, ChrW(216), "&Oslash;") myText = Replace(myText, ChrW(217), "&Ugrave;") myText = Replace(myText, ChrW(218), "&Uacute;") myText = Replace(myText, ChrW(219), "&Ucirc;") myText = Replace(myText, ChrW(220), "&Uuml;") myText = Replace(myText, ChrW(221), "&Yacute;") myText = Replace(myText, ChrW(222), "&THORN;") myText = Replace(myText, ChrW(223), "&szlig;") myText = Replace(myText, ChrW(224), "&agrave;") myText = Replace(myText, ChrW(225), "&aacute;") myText = Replace(myText, ChrW(226), "&acirc;") myText = Replace(myText, ChrW(227), "&atilde;") myText = Replace(myText, ChrW(228), "&auml;") myText = Replace(myText, ChrW(229), "&aring;") myText = Replace(myText, ChrW(230), "&aelig;") myText = Replace(myText, ChrW(231), "&ccedil;") myText = Replace(myText, ChrW(232), "&egrave;") myText = Replace(myText, ChrW(233), "&eacute;") myText = Replace(myText, ChrW(234), "&ecirc;") myText = Replace(myText, ChrW(235), "&euml;") myText = Replace(myText, ChrW(236), "&igrave;") myText = Replace(myText, ChrW(237), "&iacute;") myText = Replace(myText, ChrW(238), "&icirc;") myText = Replace(myText, ChrW(239), "&iuml;") myText = Replace(myText, ChrW(240), "&eth;") myText = Replace(myText, ChrW(241), "&ntilde;") myText = Replace(myText, ChrW(242), "&ograve;") myText = Replace(myText, ChrW(243), "&oacute;") myText = Replace(myText, ChrW(244), "&ocirc;") myText = Replace(myText, ChrW(245), "&otilde;") myText = Replace(myText, ChrW(246), "&ouml;") Rem myText = Replace(myText, ChrW(248), "&oslash;") myText = Replace(myText, ChrW(249), "&ugrave;") myText = Replace(myText, ChrW(250), "&uacute;") myText = Replace(myText, ChrW(251), "&ucirc;") myText = Replace(myText, ChrW(252), "&uuml;") myText = Replace(myText, ChrW(253), "&yacute;") myText = Replace(myText, ChrW(254), "&thorn;") myText = Replace(myText, ChrW(255), "&yuml;") ' For i = 256 To 511 myText = Replace(myText, ChrW(i), "&#" & i & ";") Next ' i End Sub ' EspizoRvOthers *----*----* *----*----* *----*----* *----*----*
inserted by FC2 system