Office関連

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

関連記事

  1. Office関連

    Gmail APIを使ってメール送信するVBAマクロ(3)

    前回、前々回とGmail APIを扱ってきましたが、今回は前々回の記事…

  2. Word

    リボンからプリンタを選択して簡単に印刷できるようにする(Word)

    今回はdynamicMenu要素のgetContent属性のコールバッ…

  3. アイコン一覧

    Office 2013 アイコン一覧(X,Y,Z)

    ・Office 2013 アイコン一覧 NUM…

  4. アイコン一覧

    Office 365アイコン(imageMso)一覧(V)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  5. Office アドイン

    「マイクロソフト Office 用アプリ開発スタートアップガイド」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。日本初(恐らく)…

コメント

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP