コード
Function StrCONVvbNarrowAlfa(buf) ' As String
Dim REG : Set REG = CreateObject("VBScript.REGExp")
'DIm FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
'Dim WSH : Set WSH = CreateObject("WScript.Shell")
'Dim oShell : Set oShell = CreateObject("Shell.Application")
REG.Global = True : REG.Multiline = False : REG.IgnoreCase = False
Dim oFolder, oFile, oSubfolder, TS
Dim MC, M, im, Length, firstpoint
DIm i , Cnt , x
REG.pattern = "[0-9]"
set MC = REG.Execute(buf)
if MC.Count > 0 then
For im = 0 to MC.Count -1
i = Asc(Mc(im).value)
x = Clng(Asc(Mc(im).value) + 32225)
buf = Replace(buf , MC.item(im).Value, chr(x),1, -1, 1)
next
end if
REG.pattern = "[A-Z]"
set MC = REG.Execute(buf)
if MC.Count > 0 then
For im = 0 to MC.Count -1
i = Asc(Mc(im).value)
x = Clng(Asc(Mc(im).value) + 32225)
buf = Replace(buf , MC.item(im).Value, chr(x),1, -1, 1)
next
end if
REG.pattern = "[a-z]"
set MC = REG.Execute(buf)
if MC.Count > 0 then
For im = 0 to MC.Count -1
i = Asc(Mc(im).value)
x = Clng(Asc(Mc(im).value) + 32224)
buf = Replace(buf , MC.item(im).Value, chr(x),1, -1, 1)
next
end if
Set REG = Nothing
StrCONVvbNarrowAlfa = buf
End Function
原理と限界
要は正規表現で全角を抜き出してコードをずらすというもの。
ただし数字と英語の大文字、それらと英語の小文字ではずらす数が違う。
また記号はまた別の値になる。
というわけでまず英数字だけ変換しています。