'  ﾊﾝｶｸｶﾅをゼンカクに変換する関数 hankakuToZenkaku v0.9 1998.6.22
'
'　原作者　古口正巳　[koguchi@sf.airnet.ne.jp http://www.sf.airnet.ne.jp/koguchi/]
'
'　ﾊﾝｶｸｶﾅを含む文字列をゼンカクカナに変換する関数です。
'    StrConv(文字列, vbWide)では半角英数や数字まで全角に変換されてしまいます。
'
'　CGI4VBは全角カナしか使えないので，半角カナを使った文章を全角に変換するのに用います。
'
'　　このプログラムはコード改変可能なフリーフェアであり、いかなる条件でも正しく動作する事を保証してません。
'　　各自のリスクで実行して下さい。このプログラムを利用していかなるトラブルが発生しても関知しません。
'
'　使用方法
'    文字型に変換する文字列を格納し関数を呼び出す。返り値は関数名に格納される
'　　サンプルはデーターベース変換の例を示すので，DAOの参照設定をして，コマンドボタンを一つ配置してからボタンを押すと実行される。
'
Option Explicit

Private Sub Command1_Click() 'コマンドボタンを一つ配置する
    Dim db As Database
    Dim rs As Recordset
    
    Set db = OpenDatabase("c:\kana.mdb") '変換したいデーターベース名
    Set rs = db.OpenRecordset("kana") '変換したいテーブル名
    rs.MoveFirst '最初のレコードに移動
    Do While Not rs.EOF 'レコードがある間繰り返す
        If Not IsNull(rs!hankaku) Then 'null値でなければ
            rs.Edit 'レコード編集
            rs!zenkaku = hankakuToZenkaku(rs!hankaku) '事故を防ぐために別なフィールドに格納する。
            'Debug.Print rs!hankaku, hankakuToZenkaku(rs!hankaku)
            rs.Update 'レコード更新
        End If
        rs.MoveNext '次のレコードに移動
    Loop
    rs.Close '後処理
    db.Close
End Sub

Public Function hankakuToZenkaku(s As String) As String 'ハンカクカナを全角カナに変換する。
    Dim i As Long 'counter
    Dim sl As Long 'len(s)
    Dim ss As String 'temp s
    
    sl = Len(s)
    For i = 1 To sl - 1 '最後の文字−１まで繰り返す
        ss = Mid(s, i, 1)
        If (ss >= Chr(&HA0)) And (ss <= Chr(&HDF)) Then 'ﾊﾝｶｸｶﾅ
            Select Case Mid(s, i + 1, 1)
                Case Chr(&HDE) '濁音
                    hankakuToZenkaku = hankakuToZenkaku & StrConv(ss & "ﾞ", vbWide)
                    i = i + 1
                Case Chr(&HDF) '半濁音
                    hankakuToZenkaku = hankakuToZenkaku & StrConv(ss & "ﾟ", vbWide)
                    i = i + 1
                Case Else '単独
                    hankakuToZenkaku = hankakuToZenkaku & StrConv(ss, vbWide)
            End Select
        Else
            hankakuToZenkaku = hankakuToZenkaku & ss
        End If
    Next i
    If i = sl Then '最終文字に対する処理
        ss = Mid(s, i, 1)
        If (ss >= Chr(&HA0)) And (ss <= Chr(&HDF)) Then 'ﾊﾝｶｸｶﾅ
            hankakuToZenkaku = hankakuToZenkaku & StrConv(ss, vbWide)
        Else
            hankakuToZenkaku = hankakuToZenkaku & ss
        End If
    End If
End Function