以前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を元にしていますが、もしかしたら抜けがあるかもしれません。




















この記事へのコメントはありません。