//全角半角変換用文字列定数
Const FullKana = "。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワ゛゜";
Const HalfKana = "｡｢｣､･ｦｧｨｩｪｫｬｭｮｯｰｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜﾝﾞﾟ";
Const FullKana2 = "ヴガギグゲゴザジズゼゾダヂヅデドバビブベボパピプペポ";
Const HalfKana2 = "ｳﾞｶﾞｷﾞｸﾞｹﾞｺﾞｻﾞｼﾞｽﾞｾﾞｿﾞﾀﾞﾁﾞﾂﾞﾃﾞﾄﾞﾊﾞﾋﾞﾌﾞﾍﾞﾎﾞﾊﾟﾋﾟﾌﾟﾍﾟﾎﾟ";
Const FullAlphabet = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ";
Const HalfAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
Const FullNumber = "０１２３４５６７８９";
Const HalfNumber = "0123456789";
Const FullSymbol = " ！”＃＄％＆’（）＊＋，－．／：；＜＝＞？＠［￥］＾＿‘｛｜｝～";
Const HalfSymbol = " !"#$%&'()*+,-./:;<=>?@[\]^_`{|}~";
//大文字小文字変換用文字列定数
Const UpperCase = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺABCDEFGHIJKLMNOPQRSTUVWXYZ";
Const LowerCase = "ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚabcdefghijklmnopqrstuvwxyz";
//ひらがなカタカナ変換用文字列定数
Const HiraKana = "をぁぃぅぇぉゃゅょっあいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわんゐゑ";
Const HiraKana2= "がぎぐげござじずぜぞだぢづでどばびぶべぼぱぴぷぺぽ";
Const HiraKana3= "う゛";
Const KataKana = "ヲァィゥェォャュョッアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワンヰヱ";
Const KataKana2= "ガギグゲゴザジズゼゾダヂヅデドバビブベボパピプペポ";
Const KataKana3= "ヴ";
Const KataKana4= "ｦｧｨｩｪｫｬｭｮｯｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜﾝ";
Const KataKana5= "ｶﾞｷﾞｸﾞｹﾞｺﾞｻﾞｼﾞｽﾞｾﾞｿﾞﾀﾞﾁﾞﾂﾞﾃﾞﾄﾞﾊﾞﾋﾞﾌﾞﾍﾞﾎﾞﾊﾟﾋﾟﾌﾟﾍﾟﾎﾟ";
Function TranslateString(OriginalString, strSource, strDestination)
Dim strResult
strResult = OriginalString
Dim nLength
nLength = Len(strSource)
Dim i
For i = 1 To nLength
strResult = Replace(strResult, Mid(strSource, i, 1), Mid(strDestination, i, 1))
Next
TranslateString = strResult
End Function
Function EncodeWKana(OriginalString)
Dim strResult
strResult = OriginalString
If chkWKana.checked Then
strResult = TranslateString(strResult, FullKana, HalfKana)
Dim nLength
nLength = Len(FullKana2)
Dim i
For i = 1 To nLength
strResult = Replace(strResult, Mid(FullKana2, i, 1), Mid(HalfKana2, ((i -1) *2) +1, 2))
Next
End If
EncodeWKana = strResult
End Function
Function EncodeWAlphabet(OriginalString)
Dim strResult
strResult = OriginalString
If chkWAlphabet.checked Then
strResult = TranslateString(strResult, FullAlphabet, HalfAlphabet)
End If
EncodeWAlphabet = strResult
End Function
Function EncodeWNumber(OriginalString)
Dim strResult
strResult = OriginalString
If chkWNumber.checked Then
strResult = TranslateString(strResult, FullNumber, HalfNumber)
End If
EncodeWNumber = strResult
End Function
Function EncodeWSymbol(OriginalString)
Dim strResult
strResult = OriginalString
If chkWSymbol.checked Then
strResult = TranslateString(strResult, FullSymbol, HalfSymbol)
End If
EncodeWSymbol = strResult
End Function
Function EncodeCase(OriginalString)
Dim strResult
strResult = OriginalString
If chkCase.checked Then
strResult = TranslateString(strResult, UpperCase, LowerCase)
End If
EncodeCase = strResult
End Function
Function EncodeKana(OriginalString)
Dim strResult
strResult = OriginalString
If chkKana.checked Then
strResult = Replace(strResult, HiraKana3, KanaKana3)
strResult = TranslateString(strResult, HiraKana, KataKana)
strResult = TranslateString(strResult, HiraKana2, KataKana2)
End If
EncodeKana = strResult
End Function
Function DecodeWKana(OriginalString)
Dim strResult
strResult = OriginalString
If chkWKana.checked Then
Dim nLength
nLength = Len(FullKana2)
Dim i
For i = 1 To nLength
strResult = Replace(strResult, Mid(HalfKana2, ((i -1) *2) +1, 2), Mid(FullKana2, i, 1))
Next
strResult = TranslateString(strResult, HalfKana, FullKana)
End If
DecodeWKana = strResult
End Function
Function DecodeWAlphabet(OriginalString)
Dim strResult
strResult = OriginalString
If chkWAlphabet.checked Then
strResult = TranslateString(strResult, HalfAlphabet, FullAlphabet)
End If
DecodeWAlphabet = strResult
End Function
Function DecodeWNumber(OriginalString)
Dim strResult
strResult = OriginalString
If chkWNumber.checked Then
strResult = TranslateString(strResult, HalfNumber, FullNumber)
End If
DecodeWNumber = strResult
End Function
Function DecodeWSymbol(OriginalString)
Dim strResult
strResult = OriginalString
If chkWSymbol.checked Then
strResult = TranslateString(strResult, HalfSymbol, FullSymbol)
End If
DecodeWSymbol = strResult
End Function
Function DecodeCase(OriginalString)
Dim strResult
strResult = OriginalString
If chkCase.checked Then
strResult = TranslateString(strResult, LowerCase, UpperCase)
End If
DecodeCase = strResult
End Function
Function DecodeKana(OriginalString)
Dim strResult
strResult = OriginalString
If chkKana.checked Then
Dim nLength
nLength = Len(HiraKana2)
Dim i
For i = 1 To nLength
strResult = Replace(strResult, Mid(KataKana5, ((i -1) *2) +1, 2), Mid(HiraKana2, i, 1))
Next
strResult = TranslateString(strResult, KataKana, HiraKana)
strResult = TranslateString(strResult, KataKana2, HiraKana2)
strResult = Replace(strResult, KanaKana3, HiraKana3)
strResult = TranslateString(strResult, KataKana4, HiraKana)
End If
DecodeKana = strResult
End Function
Function EncodeString(OriginalString)
Dim strResult
strResult = OriginalString
strResult = EncodeCase(strResult)
strResult = EncodeKana(strResult)
strResult = EncodeWKana(strResult)
strResult = EncodeWAlphabet(strResult)
strResult = EncodeWNumber(strResult)
strResult = EncodeWSymbol(strResult)
EncodeString = strResult
End Function
Function DecodeString(OriginalString)
Dim strResult
strResult = OriginalString
strResult = DecodeWKana(strResult)
strResult = DecodeWAlphabet(strResult)
strResult = DecodeWNumber(strResult)
strResult = DecodeWSymbol(strResult)
strResult = DecodeCase(strResult)
strResult = DecodeKana(strResult)
DecodeString = strResult
End Function
入力チェックについて方法もありますよ
