Google TTSで文字列を読み上げるExcelアドイン

ホーム
Excel, Office関連, リボン関連, Google関連, 翻訳サービス関連
Google TTSで文字列を読み上げるExcelアドイン

Excel

2012.02.15

Google TTSで文字列を読み上げるExcelアドイン

前回の記事で書いたGoogle TTSで文字列を読み上げるマクロ(言語自動検出対応版)をアドイン化してみました。
Excel 2007/2010対応で、このアドインを登録するとホームタブに「読み上げ」グループが追加されます。

セルやテキストが挿入されたオートシェイプを選択した状態で、読み上げグループのGoogle TTSボタンをクリックすると、言語を自動的に検出して文字列を読み上げてくれます。

自動検出ではなく言語を指定したい場合は、下段のメニューからは言語を選択することができます。

ファイルは下記リンクからダウンロードすることができます(64ビット版Excelには非対応)。

※ 当アドインはGoogle TTSの仕様変更により今後利用できなくなる可能性があります。

Google TTSで文字列を読み上げるアドイン

なお、当アドインのリボンXMLとVBAコードは下記の通りです。

リボンXML：

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon>
    <tabs>
      <tab idMso="TabHome">
        <group id="grpGoogleTTS" label="読み上げ" imageMso="Translate">
          <splitButton id="sbnGoogleTTS" size="large">
            <button id="btnGoogleLanguage1" label="Google TTS" imageMso="Translate" onAction="btnGoogleLanguage_onAction" tag="auto" screentip="文字列の読み上げ(Google TTS)" supertip="言語を自動的に検出して読み上げます。" />
            <menu id="mnuGoogleTTS" label="Google TTS" itemSize="normal" screentip="文字列の読み上げ(Google TTS)" supertip="言語を選択してください。">
              <button id="btnGoogleLanguage2" label="日本語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ja" screentip="文字列の読み上げ(Google TTS)" supertip="日本語で読み上げます。" />
              <button id="btnGoogleLanguage3" label="英語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="en" screentip="文字列の読み上げ(Google TTS)" supertip="英語で読み上げます。" />
              <button id="btnGoogleLanguage4" label="中国語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="zh-CN" screentip="文字列の読み上げ(Google TTS)" supertip="中国語で読み上げます。" />
              <button id="btnGoogleLanguage5" label="韓国語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ko" screentip="文字列の読み上げ(Google TTS)" supertip="韓国語で読み上げます。" />
              <button id="btnGoogleLanguage6" label="アイスランド語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="is" screentip="文字列の読み上げ(Google TTS)" supertip="アイスランド語で読み上げます。" />
              <button id="btnGoogleLanguage7" label="アフリカーンス語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="af" screentip="文字列の読み上げ(Google TTS)" supertip="アフリカーンス語で読み上げます。" />
              <button id="btnGoogleLanguage8" label="アラビア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ar" screentip="文字列の読み上げ(Google TTS)" supertip="アラビア語で読み上げます。" />
              <button id="btnGoogleLanguage9" label="アルバニア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="sq" screentip="文字列の読み上げ(Google TTS)" supertip="アルバニア語で読み上げます。" />
              <button id="btnGoogleLanguage10" label="アルメニア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="hy" screentip="文字列の読み上げ(Google TTS)" supertip="アルメニア語で読み上げます。" />
              <button id="btnGoogleLanguage11" label="イタリア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="it" screentip="文字列の読み上げ(Google TTS)" supertip="イタリア語で読み上げます。" />
              <button id="btnGoogleLanguage12" label="インドネシア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="id" screentip="文字列の読み上げ(Google TTS)" supertip="インドネシア語で読み上げます。" />
              <button id="btnGoogleLanguage13" label="ウェールズ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="cy" screentip="文字列の読み上げ(Google TTS)" supertip="ウェールズ語で読み上げます。" />
              <button id="btnGoogleLanguage14" label="オランダ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="nl" screentip="文字列の読み上げ(Google TTS)" supertip="オランダ語で読み上げます。" />
              <button id="btnGoogleLanguage15" label="カタロニア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ca" screentip="文字列の読み上げ(Google TTS)" supertip="カタロニア語で読み上げます。" />
              <button id="btnGoogleLanguage16" label="ギリシャ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="el" screentip="文字列の読み上げ(Google TTS)" supertip="ギリシャ語で読み上げます。" />
              <button id="btnGoogleLanguage17" label="クレオール語(ハイチ)" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ht" screentip="文字列の読み上げ(Google TTS)" supertip="クレオール語(ハイチ)で読み上げます。" />
              <button id="btnGoogleLanguage18" label="クロアチア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="hr" screentip="文字列の読み上げ(Google TTS)" supertip="クロアチア語で読み上げます。" />
              <button id="btnGoogleLanguage19" label="スウェーデン語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="sv" screentip="文字列の読み上げ(Google TTS)" supertip="スウェーデン語で読み上げます。" />
              <button id="btnGoogleLanguage20" label="スペイン語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="es" screentip="文字列の読み上げ(Google TTS)" supertip="スペイン語で読み上げます。" />
              <button id="btnGoogleLanguage21" label="スロバキア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="sk" screentip="文字列の読み上げ(Google TTS)" supertip="スロバキア語で読み上げます。" />
              <button id="btnGoogleLanguage22" label="スワヒリ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="sw" screentip="文字列の読み上げ(Google TTS)" supertip="スワヒリ語で読み上げます。" />
              <button id="btnGoogleLanguage23" label="セルビア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="sr" screentip="文字列の読み上げ(Google TTS)" supertip="セルビア語で読み上げます。" />
              <button id="btnGoogleLanguage24" label="タイ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="th" screentip="文字列の読み上げ(Google TTS)" supertip="タイ語で読み上げます。" />
              <button id="btnGoogleLanguage25" label="タミル語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ta" screentip="文字列の読み上げ(Google TTS)" supertip="タミル語で読み上げます。" />
              <button id="btnGoogleLanguage26" label="チェコ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="cs" screentip="文字列の読み上げ(Google TTS)" supertip="チェコ語で読み上げます。" />
              <button id="btnGoogleLanguage27" label="デンマーク語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="da" screentip="文字列の読み上げ(Google TTS)" supertip="デンマーク語で読み上げます。" />
              <button id="btnGoogleLanguage28" label="ドイツ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="de" screentip="文字列の読み上げ(Google TTS)" supertip="ドイツ語で読み上げます。" />
              <button id="btnGoogleLanguage29" label="トルコ語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="tr" screentip="文字列の読み上げ(Google TTS)" supertip="トルコ語で読み上げます。" />
              <button id="btnGoogleLanguage30" label="ノルウェー語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="no" screentip="文字列の読み上げ(Google TTS)" supertip="ノルウェー語で読み上げます。" />
              <button id="btnGoogleLanguage31" label="ハンガリー語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="hu" screentip="文字列の読み上げ(Google TTS)" supertip="ハンガリー語で読み上げます。" />
              <button id="btnGoogleLanguage32" label="ヒンディー語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="hi" screentip="文字列の読み上げ(Google TTS)" supertip="ヒンディー語で読み上げます。" />
              <button id="btnGoogleLanguage33" label="フィンランド語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="fi" screentip="文字列の読み上げ(Google TTS)" supertip="フィンランド語で読み上げます。" />
              <button id="btnGoogleLanguage34" label="フランス語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="fr" screentip="文字列の読み上げ(Google TTS)" supertip="フランス語で読み上げます。" />
              <button id="btnGoogleLanguage35" label="ベトナム語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="vi" screentip="文字列の読み上げ(Google TTS)" supertip="ベトナム語で読み上げます。" />
              <button id="btnGoogleLanguage36" label="ポーランド語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="pl" screentip="文字列の読み上げ(Google TTS)" supertip="ポーランド語で読み上げます。" />
              <button id="btnGoogleLanguage37" label="ポルトガル語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="pt" screentip="文字列の読み上げ(Google TTS)" supertip="ポルトガル語で読み上げます。" />
              <button id="btnGoogleLanguage38" label="マケドニア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="mk" screentip="文字列の読み上げ(Google TTS)" supertip="マケドニア語で読み上げます。" />
              <button id="btnGoogleLanguage39" label="ラテン語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="la" screentip="文字列の読み上げ(Google TTS)" supertip="ラテン語で読み上げます。" />
              <button id="btnGoogleLanguage40" label="ラトビア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="lv" screentip="文字列の読み上げ(Google TTS)" supertip="ラトビア語で読み上げます。" />
              <button id="btnGoogleLanguage41" label="ルーマニア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ro" screentip="文字列の読み上げ(Google TTS)" supertip="ルーマニア語で読み上げます。" />
              <button id="btnGoogleLanguage42" label="ロシア語" imageMso="SetLanguage" onAction="btnGoogleLanguage_onAction" tag="ru" screentip="文字列の読み上げ(Google TTS)" supertip="ロシア語で読み上げます。" />
            </menu>
          </splitButton>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

VBAコード：

Option Explicit

Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" ( _
        ByVal lpstrCommand As String, _
        ByVal lpstrReturnString As String, _
        ByVal uReturnLength As Long, _
        ByVal hwndCallback As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long

Public Sub btnGoogleLanguage_onAction(control As IRibbonControl)
'読み上げ処理
  Dim r As Range
  Dim txt As String
  
  If TypeName(Selection) = "Range" Then
    For Each r In Selection.Cells
      If Len(Trim(r.Value)) > 0 Then
        TTSGoogle r.Value, control.Tag
      End If
    Next
  ElseIf TypeName(Selection) = "TextBox" Then
    TTSGoogle Selection.Text, control.Tag
  Else
    txt = "" '初期化
    If VarType(Selection) = vbObject Then
      If TypeName(Selection) = "Shape" Then
        If Selection.TextFrame2.HasText Then
          txt = Selection.TextFrame2.TextRange.Text
        End If
      Else
        On Error Resume Next
        If Selection.ShapeRange.TextFrame2.HasText Then
          txt = Selection.ShapeRange.TextFrame2.TextRange.Text
        End If
        On Error GoTo 0
      End If
    End If
    
    If Len(Trim(txt)) > 0 Then
      TTSGoogle txt, control.Tag
    End If
  End If
End Sub

Private Sub TTSGoogle(ByVal txt As String, Optional ByVal lng As String = "ja")
'Google TTSを利用して音声再生
  Dim TTSFilePath As String
  Dim tmp As String
  Dim ret As Long
  
  '**********************************************************
  '■ 対応する言語(引数lng) http://translate.google.com/ より
  '   自動検出:auto
  '   アイスランド語:is
  '   アフリカーンス語:af
  '   アラビア語:ar
  '   アルバニア語:sq
  '   アルメニア語:hy
  '   イタリア語:it
  '   インドネシア語:id
  '   ウェールズ語:cy
  '   オランダ語:nl
  '   カタロニア語:ca
  '   ギリシャ語:el
  '   クレオール語(ハイチ):ht
  '   クロアチア語:hr
  '   スウェーデン語:sv
  '   スペイン語:es
  '   スロバキア語:sk
  '   スワヒリ語:sw
  '   セルビア語:sr
  '   タイ語:th
  '   タミル語:ta
  '   チェコ語:cs
  '   デンマーク語:da
  '   ドイツ語:de
  '   トルコ語:tr
  '   ノルウェー語:no
  '   ハンガリー語:hu
  '   ヒンディー語:hi
  '   フィンランド語:fi
  '   フランス語:fr
  '   ベトナム語:vi
  '   ポーランド語:pl
  '   ポルトガル語:pt
  '   マケドニア語:mk
  '   ラテン語:la
  '   ラトビア語:lv
  '   ルーマニア語:ro
  '   ロシア語:ru
  '   英語:en
  '   韓国語:ko
  '   中国語:zh-CN
  '   日本語:ja
  '**********************************************************
  
  '文字列確認
  tmp = Replace(txt, "　", "")
  tmp = Replace(tmp, " ", "")
  tmp = Replace(tmp, vbCrLf, "")
  tmp = Replace(tmp, vbCr, "")
  tmp = Replace(tmp, vbLf, "")
  If Len(tmp) < 1 Then
    MsgBox "音声出力する文字列を指定してください。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  If Len(txt) > 100 Then
    MsgBox "文字数が多すぎます。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  
  '言語自動検出対応
  Select Case LCase$(lng)
    Case "auto"
      lng = DetectLanguageG(txt)
      'Debug.Print lng
      If Len(lng) < 1 Then
        MsgBox "自動検出できませんでした。" & vbCrLf & "言語を「日本語」に設定します。", vbInformation + vbSystemModal
        lng = "ja"
      End If
  End Select
  
  '音声ファイルの保存
  With CreateObject("Scripting.FileSystemObject")
    TTSFilePath = .GetSpecialFolder(2) & Application.PathSeparator & "tts.mp3"
    If .FileExists(TTSFilePath) Then Kill TTSFilePath 'ファイルを事前に削除
    ret = URLDownloadToFile(0&, "http://translate.google.com/translate_tts?tl=" & lng & "&q=" & EncodeURL(txt), TTSFilePath, 0&, 0&)
    If ret <> 0& Then
      MsgBox "音声ファイルがダウンロードできませんでした。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Sub
    End If
    If .FileExists(TTSFilePath) = False Then
      MsgBox "音声ファイルが保存されていません。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Sub
    End If
  End With
  
  '音声ファイルの再生・削除
  mciSendString "Open " & Chr(34) & TTSFilePath & Chr(34), "", 0&, 0&
  mciSendString "Play " & Chr(34) & TTSFilePath & Chr(34) & " wait", "", 0&, 0&
  mciSendString "Close " & Chr(34) & TTSFilePath & Chr(34), "", 0&, 0&
  Kill TTSFilePath
End Sub

Private Function DetectLanguageG(ByVal txt As String) As String
'言語自動検出
  Dim ret As String
  Dim js As String
  
  ret = "": js = "" '初期化
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "http://translate.google.com/translate_a/t?client=0&sl=auto&text=" & EncodeURL(txt), False
    .Send
    If .Status = 200 Then js = .responseText
  End With
  On Error GoTo 0
  If Len(js) > 0 Then
    js = "(" & js & ")"
    With CreateObject("ScriptControl")
      .Language = "JScript"
      ret = .CodeObject.eval(js).src
    End With
  End If
  DetectLanguageG = 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