以前mougの質問用に書いたコードが出てきたので、一部修正しました。
Option Explicit Public Sub Sample() Dim shell As Object Dim i As Long Set shell = CreateObject("WScript.Shell") With Selection For i = 1 To .Characters.Count shell.Popup "文字:" & .Characters(i).Text & vbNewLine & _ "アラビア文字かどうか:" & IsArabic(.Characters(i).Text) Next End With End Sub Private Function IsArabic(ByVal char As String) As Boolean 'アラビア文字判別 '※ 下記Webページ参照 'https://en.wikipedia.org/wiki/Unicode_block 'https://en.wikipedia.org/wiki/Arabic_script_in_Unicode 'https://ja.wikipedia.org/wiki/%E3%82%A2%E3%83%A9%E3%83%93%E3%82%A2%E6%96%87%E5%AD%97 'http://www.asahi-net.or.jp/~ax2s-kmtn/ref/unicode/m_eastern.html Dim cc As Variant Dim ret As Boolean ret = True '初期化 cc = Val("&H" & Hex(AscW(char)) & "&") '例外処理 Select Case cc Case 64976 To 65007, 65279 '非文字(U+FDD0-U+FDEF), BOM(U+FEFF) ret = False: GoTo Fin End Select 'Unicode範囲 Select Case cc Case 1536 To 1791 'Arabic (U+0600-U+06FF) Case 1872 To 1919 'Arabic Supplement(U+0750-U+077F) Case 2208 To 2303 'Arabic Extended-A(U+08A0-U+08FF) Case 64336 To 65023 'Arabic Presentation Forms-A(U+FB50-U+FDFF) Case 65136 To 65279 'Arabic Presentation Forms-B(U+FE70-U+FEFF) Case 69216 To 69247 'Rumi Numeral Symbols(U+10E60-U+10E7F) Case 126464 To 126719 'Arabic Mathematical Alphabetic Symbols(U+1EE00-U+1EEFF) Case Else ret = False End Select Fin: IsArabic = ret End Function
下記記事と同様、文字コードでアラビア文字かどうかを判別しています。
コードの範囲はWikipediaを元にしていますが、もしかしたら抜けがあるかもしれません。
この記事へのコメントはありません。