連載第7回目の目的

連載第7回目では、前回の続きとしてExcel VBAにおけるJSONデータによるWebサービスの呼び出しについての手順を学びます。前回で、APIの概要を紹介し、IDの取得やAPI呼び出しのテストを行い、ワークシートの基本的な準備を済ませました。今回はスクリプトを作成し、サンプルを完成させます（図1）。

  • 図1：完成サンプル

    図1：完成サンプル

▼完成サンプルのExcelファイル
https://github.com/wateryinhare62/mynavi_excelvba_webservice

なお、本連載では動作確認をWindows 10 Pro（64bit）、Microsoft 365（Excel 16.0、VBA 7.1）で行っています。旧バージョンや単体のExcelで試す場合にはご注意下さい。

VBAの準備

前回では、ワークシートを準備しました。今回はスクリプトを書いていきますので、まずはVBAの事前準備を行っておきましょう。

VBA-JSONを準備する

テキスト解析APIは、被ふりがな文字列をJSONデータで受け取り、結果をJSONデータで返します。このようにVBAからJSONデータを使いますので、そのために必要なライブラリを準備します。第3回などと同様に、「VBA-JSON」というサードパーティのライブラリを使用します。第3回の記事を参照して、「Microsoft Scripting Runtime」への参照設定を有効にすることを含めた、VBA-JSONの準備を行ってください。

Microsoft ActiveX Data Objects Libraryを準備する

JSONデータをPOSTメソッドでAPIに送信する際には、JSONデータをUTF-8形式にエンコードする必要があります。そのための関数の作成に、ADODB.Streamモジュールを使用します。このモジュールの使用にはMicrosoft ActiveX Data Objects Libraryが必要になりますので、これへの参照設定を有効にしておいてください。
Visual Basic Editorにて、［ツール］メニューの［参照設定］から「参照設定 - VBA Project」を開きます。［参照可能なライブラリ ファイル］から「Microsoft ActiveX Data Objects X.X Library」（X.Xはバージョン）を見つけて、チェックが入っていなければチェックを入れます（ここでは6.1）。そして［OK］ボタンをクリックすれば終了です（図2）。

  • 図2：「Microsoft ActiveX Data Objects 6.1 Library」を有効化

    図2：「Microsoft ActiveX Data Objects 6.1 Library」を有効化

スクリプトを書いていく

ここから、Visual Basic Editorを使って、以下の順番でスクリプトを書いていきます。

  • コンボボックスに項目リストを追加するスクリプト
  • APIにアクセスするスクリプト
  • ふりがなを取得するスクリプト
  • ふりがなを設定するスクリプト

コンボボックスに項目リストを追加するスクリプト

コンボボックスは、ふりがな対象学年を選択するためのものですが、配置直後は項目リストは空ですので、学年一覧を項目リストとして設定しておきます。設定の方法にはいろいろありますが、ここではシンプルにコンボボックスがボタンクリックでプルダウンされたときに設定することにします。
［開発］タブから「コントロール」の［デザインモード］をクリックして有効にします。そしてコンボボックスの上で右クリックして表示されるメニューから［コードの表示］をクリックします（図3）。Visual Basic Editorが開き、ComboBox1_Changeというイベントハンドラーが自動で作成されて表示されます（図4）。

  • 図3：コンボボックスのコードを表示させる

    図3：コンボボックスのコードを表示させる

  • 図4：コンボボックスのコードが表示された

    図4：コンボボックスのコードが表示された

ComboBox1_Changeは、コンボボックスの選択内容が変化したときに呼び出されるイベントハンドラーですが、今回は使いませんので削除してしまって構いません。コードの上のドロップダウンが「ComboBox1」となっているのを確認して、その右のドロップダウンから「DropButtonClick」を選択します。すると、ComboBox1_DropButtonClickイベントハンドラーが追加されますので、ここにリスト1のようにスクリプトを追加してください（ComboBox1_DropButtonClickは、ドロップボタンがクリックされたときに呼び出されるイベントハンドラーです）。

［リスト1］ComboBox1_DropButtonClickイベントハンドラー

Private Sub ComboBox1_DropButtonClick()
    ' 項目リストをクリアする
    ComboBox1.List = Array()    '(1)
    ' 項目リストをセットする
    ComboBox1.AddItem "1: 小学1年生向け"    '(2)
    ComboBox1.AddItem "2: 小学2年生向け"
    ComboBox1.AddItem "3: 小学3年生向け"
    ComboBox1.AddItem "4: 小学4年生向け"
    ComboBox1.AddItem "5: 小学5年生向け"
    ComboBox1.AddItem "6: 小学6年生向け"
    ComboBox1.AddItem "7: 中学生以上向け"
    ComboBox1.AddItem "8: 一般向け"
End Sub

ドロップダウンは何回も行われるので、項目リストが重複しないように（1）でクリアし、そのあとに（2）で各項目を追加しています。ワークシートを保存後、コンボボックスのドロップダウンボタンをクリックすると、設定した項目が表示されるのを確認できるはずです（図5）。

  • 図5：コンボボックスにリストが設定された

    図5：コンボボックスにリストが設定された

APIにアクセスするスクリプト

続けて、APIにアクセスするスクリプトを書いていきます。拡張性を考慮して、Webサービスへのアクセスは関数として独立させます。ComboBox1_DropButtonClickイベントハンドラーの下にスクリプトを追加していきます（表示されていない場合は、左ペインの「Microsoft Excel Objects」の「Sheet1 (Sheet1)」をダブルクリック）。APIを呼び出すスクリプトは、KickWebServiceという関数にします。少し長いので、分割して解説します。
KickWebServiceは、引数に被ふりがな文字列と対象学年を受け取って、結果としてのJSON文字列を返す関数です。まずは準備段階です（リスト2）。

［リスト2］KickWebService関数（パート1）

Private Function KickWebService(ByVal Text As String, _
    ByVal Grade As Integer) As String
    ' アプリケーションIDを変数に入れておく
    Dim Id As String
    Id = "dj00……"     '(1)
    ' URLを作成する
    Dim Url As String
    Url = "https://jlp.yahooapis.jp/FuriganaService/V2/furigana"        '(2)

アプリケーションIDは変数Idに（1）、APIのエンドポイントURLは固定なので、そのまま変数Urlにセットしておきます（2）。IDなどのハードコーディングは好ましくないので、本来なら外部ファイルにあるものを読み込んで使用したり、あるいはユーザに都度入力させるべきでしょう。ここでは、サンプルとして単純化しています。
メッセージボディは、少し面倒な手順で作成しています（リスト3）。参考として、元となるJSONデータの形式をリスト4として再掲します。

［リスト3］KickWebService関数（パート2）

    ' メッセージボディを作成する
    Dim Body, Param As Dictionary       '(3)
    Set Body = New Dictionary
    Body.Add "id", "9999"
    Body.Add "jsonrpc", "2.0"
    Body.Add "method", "jlp.furiganaservice.furigana"
    Set Param = New Dictionary          '(4)
    Param.Add "q", Text
    If Grade > 0 Then                   '(5)
        Param.Add "grade", Grade
    End If
    Body.Add "params", Param
    Dim JsonStr As String
    JsonStr = ConvertToJson(Body)       '(6)

［リスト4］元となるJSONデータの形式

{
  "id": "9999",         ←ID（任意の内容）
  "jsonrpc": "2.0",     ←バージョン（固定）
  "method": "jlp.furiganaservice.furigana",     ←メソッド（固定）
  "params": {
    "q": "ワークシートの…みよう！",      ←ふりがなを振る文字列（任意の内容）
    "grade": 1          ←学年（1～8、省略可能）
  }
}

まず、Dictionary型のオブジェクトBodyを作成し、そこに順番にキーと値を追加していきます（3）。paramsについては、さらにDictionary型のオブジェクトParamを作成し、ここに被ふりがな文字列を取得する文字列をセットし、オブジェクトBodyにオブジェクトParamを追加しています（4）。このように、Dictionary型にはさらにDictionary型（オブジェクト）を格納することが可能です。なお、（5）で対象学年を表すGradeが1以上のときのみ、gradeキーを追加しています。そして、ここが重要なのですが、VBA-JSONのConvertToJson関数を使ってDictionary型からJSON文字列への変換を行っています（6）。
最後に、APIの呼び出しになります（リスト5）。

［リスト5］KickWebService関数（パート3）

    ' リクエストを送信する
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")   '(7)
    With http
        .Open "POST", Url, False        '(8)
        .setRequestHeader "User-Agent", "Yahoo AppID: " & Id
        .setRequestHeader "Content-Type", "application/json"
        .send encodeUTF8(JsonStr)
        ' リクエスト結果を取得する
        KickWebService = .responseText  '(9)
    End With
End Function

VBAでは、WebサービスなどHTTPでアクセスする必要のあるとき、MSXML2.XMLHTTPというモジュールのオブジェクトを使用します（7）。
オブジェクト作成後、HTTPメソッドとURLを指定してOpenメソッドを呼び出し、必要なリクエストパラメータを設定した後、sendメソッドで実際の呼び出しを行います（8）（Openメソッドの構文については第3回を参照してください）。
GETメソッドではsendメソッドの引数は不要でしたが、今回はPOSTメソッドを使用するため、先ほど作成したJSON文字列をUTF-8エンコードしたものを渡しています。UTF-8エンコードが必要なのは、VBAではシフトJISを文字列のエンコードに用いているのに対し、APIはUnicode（UTF-8）を期待しているからです。ここで変換を行っておかないと、APIの呼び出しに失敗したり、文字化けしてしまいます。
なお、文字列をUTF-8エンコードするEncodeUTF8関数については、この連載では関係が薄いため掲載を割愛しますので、サンプルファイルを参照してください。
呼び出した結果はResponseTextプロパティで取得できます（9）。これが空なら何らかのエラーが発生していますが、これをそのまま関数の戻り値として返します。

ふりがなを取得するスクリプト

次に、ふりがなの取得スクリプトを書いていきましょう。ワークシートから順番に被ふりがな文字列を取り出し、取得したふりがなをもとに加工した文字列をワークシートに書き込むスクリプトを、ボタンクリックのイベントハンドラーとして追加します。コンボボックスにイベントハンドラーを追加した要領で、「CommandButton1」に「Click」を選択して、イベントハンドラーCommandButton1_Clickを作成してください。
かなり長いので、こちらも分割して解説します。まずは準備段階です（リスト6）。

［リスト6］ふりがな取得＆ワークシートへの書き込み（パート1）

    ' ふりがな取得の最大数を変数にセットする
    Dim MaxResult As Integer
    MaxResult = 10     '(1)
    ' 操作するセルの起点位置をセットする
    Dim Row As Integer, Col As Integer
    Col = 2             '(2)
    Row = 6
    ' 学年（grade）を取得する
    Dim Grade As Integer, GradeStr As String
    GradeStr = ComboBox1.Value          '(3)
    If Len(GradeStr) > 0 Then
        Grade = Val(Left(GradeStr, 1))
    Else
        Grade = 0
    End If

（1）で、ふりがなを取得する文字列の最大数を決めています。セルに被ふりがな文字列がある限り、いくらでも取得してよいのですが、万が一の場合に不要なAPI呼び出し回数を消費しないように、安全のために制限をかけています。もちろん、増やすことも可能です。（2）は、操作対象のセルの起点を決めています。すべてのセル参照はこの変数を使って行いますので、レイアウトの変更などにも追従しやすくなっています。（3）は、コンボボックスのValueプロパティから、Grade（対象学年）を取得しています。空なら0に、何か選択されていれば先頭文字を数値として評価しています。
ここからは、セルより被ふりがな文字列を取り出し、加工してセルに反映する処理を行います（リスト7）。

［リスト7］ふりがな取得＆ワークシートへの書き込み（パート2）

    Dim Count As Integer
    For Count = 1 To MaxResult '(4)
        ' 振り仮名を取得する文字列を取得。空なら終了
        Dim Text As String
        Text = Cells(Row, Col).Value    '(5)
        If Text = "" Then
            Exit For
        End If
        ' APIを呼び出す
        Dim Result As String
        Result = KickWebService(Text, Grade)   '(6)
        ' JSONデータが戻ってこない場合は処理を中止する
        If Left(Result, 1) <> "[" And Left(Result, 1) <> "{" Then
            MsgBox ("取得結果が不正です。")
            Exit For
        End If
        ' JSON文字列をディクショナリ形式に変換する
        Dim Json As Object
        Set Json = JsonConverter.ParseJson(Result)  '(7)

セルからの取得＆書き込みは、MaxResultで指定された回数だけ繰り返しますが（4）、（5）で被ふりがな文字列を取り出して、その結果が空文字列なら繰り返しを終了させます。（6）でAPIを呼び出し、有効なJSON文字列が返ってきていないと判断される場合には、エラーメッセージを表示して繰り返しを終了させます。有効ならば、VBA-JSONのParseJsonメソッドを使って、JSON文字列をディクショナリ形式のオブジェクトに変換します（7）。
続きは短いですが、ふりがなを文字列ではなくてExcelのふりがな機能として付与しています（リスト8）。

［リスト8］ふりがな取得＆ワークシートへの書き込み（パート4）

        ' ふりがなを付与するセルをセットする
        Cells(Row, Col + 3) = Text      '(8)
        Cells(Row, Col + 3).Characters.PhoneticCharacters = ""
        Cells(Row, Col + 3).Phonetic.Visible = True

（8）からは被ふりがな文字列をコピーし、すでにふりがなが存在する場合に備えてふりがなをクリアしています。この構文は後述するCharacters.PhoneticCharactersで、セルの文字列にふりがなを振るものですが、範囲を指定しない場合は「すべて」となります。そして、Phonetic.Visibleプロパティをtrueに設定しています。これは、Excelメニューの［ふりがなの表示］に相当します。
次は、少し長くなっていますが、取得したJSONデータを解析し、各セルに設定しています（リスト9）。

［リスト9］ふりがな取得＆ワークシートへの書き込み（パート5）

        ' ふりがな付き、ローマ字付きを格納する文字列をクリア
        Dim FuriganaStr As String, RomanStr As String
        FuriganaStr = ""    '(9)
        RomanStr = ""
        ' ふりがなを埋め込む位置を保持する変数を初期化
        Dim FuriganaPos As Integer
        FuriganaPos = 1     '(10)
        Dim i As Integer, j As Integer
        Dim Furigana As String, Roman As String, Surface As String
        ' wordは配列なので要素数分繰り返す
        For i = 1 To Json("result")("word").Count   '(11)
            Dim SubWord As Object
            If CheckBox1.Value = True And _
                Json("result")("word")(i).Exists("subword") Then  '(12)
                Set SubWord = Json("result")("word")(i)("subword")
                For j = 1 To SubWord.Count  '(13)
                    Furigana = SubWord(j)("furigana")
                    Roman = SubWord(j)("roman")
                    Surface = SubWord(j)("surface")
                    FuriganaPos = SetFurigana(FuriganaStr, RomanStr, _
                        Cells(Row, Col + 3), FuriganaPos, _
                        Furigana, Roman, Surface)
                Next
            Else
                Furigana = Json("result")("word")(i)("furigana")    '(14)
                Roman = Json("result")("word")(i)("roman")
                Surface = Json("result")("word")(i)("surface")
                FuriganaPos = SetFurigana(FuriganaStr, RomanStr, _
                    Cells(Row, Col + 3), FuriganaPos, Furigana, Roman, Surface)
            End If
        Next
        ' ふりがな付きとローマ字付きをセルにセット
        Cells(Row, Col + 1) = FuriganaStr   '(15)
        Cells(Row, Col + 2) = RomanStr
        ' 次のデータへ
        Row = Row + 1
    Next
    ' 最大行数までクリアする
    Range(Cells(Row, Col), Cells(Row + MaxResult, Col + 3)) = ""    '(16)
End Sub

（9）では、ふりがな付きセル、ローマ字付きセルに設定する文字列変数を初期化しています。JSONデータの内容に応じて、この変数に文字列を追加していきます。（10）では、ふりがな埋め込みセルに対してふりがなを設定するための位置の情報を初期化しています。（11）からは、word配列の要素だけ繰り返します。
（12）では、チェックボックスがチェックされており、かつsubwordキーが見つかった場合に、ルビを細かく振る処理を行っています。（14）はそれ以外の場合の処理です。（13）で、subword配列の要素だけ繰り返すほかは、（14）と処理内容は同じで、JSONデータからfurigana、roman、surfaceの情報を取り出してSetFurigana関数（後述）を呼び出すことで、ふりがな付きセル、ローマ字付きセルに設定する文字列変数の更新や、ふりがな埋め込みセルへの設定などを行っています。 （15）でセルに文字列をセットし、次の被ふりがな文字列の処理に移行します。（16）では、被ふりがな文字列が内部分のセルをクリアしています。

ふりがなを設定するスクリプト

最後に、ふりがなを設定するSetFurigana関数を示します（リスト10）。

［リスト10］ふりがな取得＆ワークシートへの書き込み（パート6）

' ふりがな文字列をセットする（新しいFuriganaPosを返す）
Private Function SetFurigana(ByRef FuriganaStr As String, ByRef RomanStr As String, _
    ByVal FuriganaCell As Object, ByVal FuriganaPos As Integer, _
    ByVal Furigana As String, ByVal Roman As String, ByVal Surface As String) As Integer
    ' 被ふりがな文字列はそのまま加える
    FuriganaStr = FuriganaStr & Surface     '(1)
    RomanStr = RomanStr & Surface
    Dim FuriganaLen As Integer
    FuriganaLen = Len(Surface)
    ' ふりがなの設定があれば加える
    If Furigana <> "" Then                  '(2)
        FuriganaStr = FuriganaStr & "＜" & Furigana & "＞"
        ' ふりがなを埋め込む
        FuriganaCell.Characters(FuriganaPos, FuriganaLen).PhoneticCharacters = Furigana
    End If
    ' ローマ字の設定があれば加える
    If Roman <> "" Then                     '(3)
        RomanStr = RomanStr & "<" & Roman & ">"
    End If
    SetFurigana = FuriganaPos + FuriganaLen '(4)
End Function

（1）では、被ふりがな文字列をセルに設定する変数にそのまま追加しています。大事なのは（2）です。ふりがながあれば、セルに設定する変数に「＜…＞」の形式で追加します。さらに、ふりがな埋め込みセルにふりがなを設定しています。この部分の構文は、リスト11の通りです。すでに、ふりがなをクリアする構文としても紹介しました。

［リスト11］セルにふりがなを設定する構文

セル.Characters(開始位置, 長さ).PhoneticCharacters = ふりがな文字列

セルにある文字列に、位置と長さを指定してふりがなを設定します。このために、位置と長さを保持する変数を用意しておいたのです。既述のとおり、開始位置と長さを省略した場合は、セルのすべてが対象となります。
（3）では、同じくローマ字の処理を行っています。ローマ字がない場合には何もしません。また、ふりがな埋め込みについての処理も行っていません。（4）で、新しいふりがな位置を関数の戻り値として返しています。

これで、必要なスクリプトの作成は終了です。ワークシートの形を整えてボタンをクリックし、冒頭の図1のような状態になれば完成です。コンボボックス、チェックボックス、被ふりがな文字列をいろいろ変えて試してみてください。

まとめ

前回と今回は、ヤフー提供のテキスト解析APIを使って、JSONデータをAPIに引き渡す手順や、JSONデータの解析の手順を紹介しました。今回は、ルビ振り機能のみを使った単純な例を示しましたが、ほかには形態素解析や校正支援など、より高度にワークシート上のテキストを処理できるAPIも用意されていますので、活用してはいかがでしょうか。 次回は、Googleマップをワークシート中に表示することに挑戦する予定です。

WINGSプロジェクト 山内直著/山田祥寛監修
＜WINGSプロジェクトについて＞テクニカル執筆プロジェクト(代表山田祥寛)。海外記事の翻訳から、主にWeb開発分野の書籍・雑誌/Web記事の執筆、講演等を幅広く手がける。一緒に執筆をできる有志を募集中