Categories
SugiBlog ホームページ制作・システム開発

Accessからはできないフリガナの割り付け

WindowsXPでは[Excelオブジェクトを使用してフリガナ入力]で紹介しているように、Accessだけで可能だったフリガナ変換が、Windows7では出来なくなっていました。
色々と方法を模索してはみたものの、解決策が見つかっていませんでした。

そして今日、なんとなく改めて挑戦してみると…なんと!(それほど大したことではありませんが;)方法が見つかりました!
といっても結局、Accessだけではできない、というのが結論です。
つまりExcelを使って実装することになります。

PHONETIC

まず、Excelの「PHONETIC」という関数。
これはセルに入力した文字のフリガナを取得することができます。

例としてこのようなExcelを用意してみます。
001

C列にPHONETIC関数を使ってフリガナを表示してみます。
002

ちゃんとフリガナが表示されていますが、実はB列のデータを入力したときの漢字に変換する前の情報を記録しているのです。
その記録された文字列を表示しているのがこの関数の機能なのです。

つまり、コピーして貼り付けた文字列だった場合は漢字のまま表示されます。
「東京都」という文字列をコピーしたのであれば、そのセルには「とうきょうと」とは打っていないからです。

同様の理由から、[Excelオブジェクトを使用してフリガナ入力]で紹介している方法では、空の文字列が返ってくるだけになってしまいました。

ではどうするのか?

答えは「Excelのマクロに実行させる」です。

標準モジュールにフリガナを取得する関数を作成しておきます。

Function gethurigana(str)
    gethurigana = Application.GetPhonetic(str)
End Function

これを利用して貼り付けた文字列のフリガナを表示してみた例がこちらです。
003
見た目には違いがわかりませんが。

Accessから実行するには?

最後に、Accessから利用する方法です。
まずはフリガナを振りたいデータをExcel形式でエクスポートします。
該当のファイルを、先ほど作成したマクロを含んだExcelファイルにて処理させる、という形になります。

処理が終わったファイルをもう一度Accessにインポートしてデータを反映させます。

マクロを含んだExcelには、起動時に実行されるように標準モジュールに以下を記述します。
※Book1.xlsxには任意のファイルのフルパスを入力してください。

Sub auto_open()

    Dim i As Long

    Workbooks.Open Filename:="Book1.xlsx"

    Windows("Book1.xlsx").Activate

    i = 2

    Do Until Range("B" & i).Value = "" '住所がなくなるまでループ

        '隣のセルにフリガナを入力
        Range("C" & i).Value = gethurigana(Range("B" & i).Value)

        i = i + 1

    Loop

    ActiveWorkbook.Save

    Application.Quit

End Sub

肝心のAccessからの処理はというと…

    Dim ws

    Dim FileName  As String
    Dim macroFile As String

    Dim i As Long

    Set ws = CreateObject("WScript.Shell")

    FileName  = "フリガナを付加するデータ.xlsx"
    macroFile = "マクロを含んだファイル.xlsm"

    DoCmd.SetWarnings False

    'フリガナなしのデータをエクスポートします。
    DoCmd.TransferSpreadsheet acExport, , "フリガナなしデータ", FileName, True

    DoCmd.SetWarnings True

    'マクロを含んだファイルを実行します。
    '第3引数にTrueを渡すことで、Excel側の処理が終わるまでAccessは待機させることができます。
    ws.Run macroFile, VbAppWinStyle.vbHide, True

    Set ws = Nothing


    DoCmd.SetWarnings False

    '処理が終わり、フリガナが付加されたデータをインポートします。
    DoCmd.TransferSpreadsheet acImport, , "地名フリガナなしデータ", FileName, True
    DoEvents

    MsgBox "フリガナ付けが終了しました。"

処理が終了し、割り付けられたフリガナを本データに反映する等の処理を行い、データを活用してください。

410 views

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

*