Yahoo!のテキスト解析Web API(ルビ振り)を使用して、漢字かな交じり文をひらがなにするマクロです。

下記マクロはYahoo!のアプリケーションIDが必須になりますので、「アプリケーションIDとは」「アプリケーションIDを登録する」を参考に、IDを事前に取得してください(取得後コード内の”ID“の値を変更)。

なお、APIの制限で一日50,000件を超えると処理できなくなってしまいますので、その点はご注意ください。

Option Explicit

Public Sub Sample()
  MsgBox GetFuriganaYahooApi(Selection.Text)
End Sub

Private Function GetFuriganaYahooApi(ByVal sentence As String, Optional ByVal grade As Long = 0)
'漢字かな交じり文をひらがなにするマクロ
  Dim url As String
  Dim d As Object
  Dim sel As Object
  Dim n As Object
  Dim ret As String
  
  'アプリケーションID
  '詳細は[http://help.yahoo.co.jp/help/jp/developer/developer-06.html]参照
  Const ID As String = "(アプリケーションID)"
  
  ret = "": Set d = Nothing '初期化
  url = "http://jlp.yahooapis.jp/FuriganaService/V1/furigana"
  url = url & "?appid=" & ID & "&sentence=" & EncodeURL(sentence)
  Select Case grade
    Case 1 To 8
      url = url & "&grade=" & CStr(grade)
  End Select
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set d = .responseXML
  End With
  On Error GoTo 0
  If Not d Is Nothing Then
    If d.SelectNodes("/ResultSet/Result/WordList/Word").Length > 0 Then
      For Each sel In d.SelectNodes("/ResultSet/Result/WordList/Word")
        Set n = sel.SelectSingleNode("Furigana")
        If Not n Is Nothing Then
          ret = ret & n.Text
          Set n = Nothing
        Else
          ret = ret & sel.SelectSingleNode("Surface").Text
        End If
      Next
    End If
  End If
  GetFuriganaYahooApi = ret
End Function

Private Function EncodeURL(ByVal sWord As String) As String
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(sWord)
  End With
End Function

精度は正直微妙なところがありますが、文章を子ども向けに変換する際には役立つかもしれません。