Excel

Google スライドで新規プレゼンテーションを作成するVBAマクロ

ここ数日PowerPointのマクロに加え、Google Apps ScriptからGoogle スライドを取り扱う方法について記事を書いてきました。

こう来ると、次はPowerPointマクロからGoogle スライドを弄ろうというのはごく自然な流れかと思います。

そこで今回は、VBAマクロからGoogle スライドで新規プレゼンテーションを作成する方法を紹介します。

Google Slides API

Google スライドには、外部からプレゼンテーションを操作するためのAPI「Google Slides API」が用意されています。

.NETPHPといった一般的な言語にはライブラリが用意されているので比較的APIも呼び出しやすいのですが、VBAにはもちろんライブラリが用意されていないので自力で実装する必要があります。

APIの呼び出しにあたっては、Authorization Codeを取得してAccess Tokenを取得して…といったフローが必要なのですが、ここでは深く解説しません。
YouTube Data APIのガイドになりますが、下記ページが比較的分かりやすくまとまっているので、参考にしていただければと思います。

下準備

APIを呼び出す前に、まずは「クライアント ID」と「クライアント シークレット」が必要になります。
前回書いた下記記事を参考に、この2つを取得してください。

クライアント IDとクライアント シークレットの準備ができたら、「Google Slides API」を有効にします。

  1. APIライブラリ(https://console.developers.google.com/apis/library)にアクセスし、Google アカウントでログインします。
  2. プロジェクトの選択」プルダウンのプロジェクトが使用するプロジェクトになっていることを確認します。
  3. 「slide」をキーワードに検索すると、「Google Slides API」がヒットするのでAPIを有効にします。

以上で準備作業は完了です。

Google スライドで新規プレゼンテーションを作成するVBAマクロ

次はいよいよコードです。
クライアント IDとクライアント シークレットはそれぞれ自分のものに置き換えてください。
また、下記コードはScriptControlを使用しているため、64ビット版のOfficeでは動作しませんので、その点も注意が必要です。

'※ScriptControlを使用しているため、64ビット版のOfficeでは動作しません。
Option Explicit

'--------------------------------------------------
'※要変更
'--------------------------------------------------
Private Const client_id As String = "(クライアント ID)"
Private Const client_secret As String = "(クライアント シークレット)"
'--------------------------------------------------
 
Private Const redirect_uri As String = "urn:ietf:wg:oauth:2.0:oob"
Private Const response_type As String = "code"
Private Const grant_type As String = "authorization_code"

Public Sub CallSlidesAPI()
  Dim ret As String
  
  ret = CreateNewPresentation("新規プレゼンテーション")
  If Len(Trim(ret)) > 0 Then
    MsgBox "presentationId:" & ret, vbInformation + vbSystemModal, "処理成功"
  Else
    MsgBox "処理が失敗しました。", vbExclamation + vbSystemModal
  End If
End Sub

Public Function CreateNewPresentation(ByVal title As String) As String
'新規プレゼンテーション作成
  Dim auth_code As String
  Dim access_token As String
  Dim presentation_id As String
  Dim res As String
  Dim json As Object
  Dim dat As Variant
  Const scopes As String = "https://www.googleapis.com/auth/drive%20https://www.googleapis.com/auth/presentations"
  Const presentation_uri As String = "https://slides.googleapis.com/v1/presentations"
  
  'Authorization Code取得
  auth_code = GetAuthorizationCode(scopes)
  If Len(Trim(auth_code)) < 1 Then Exit Function
  
  'Access Token取得
  access_token = GetAccessToken(auth_code)
  If Len(Trim(access_token)) < 1 Then Exit Function
  
  'API実行
  dat = "{""title"": """ & title & """}"
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", presentation_uri, False
    .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
    .SetRequestHeader "Authorization", "Bearer " & access_token
    .Send dat
    Select Case .Status
      Case 200:
        res = "(" & .responseText & ")"
        With CreateObject("ScriptControl")
          .Language = "JScript"
          Set json = .Eval(res)
          If Not json Is Nothing Then presentation_id = VBA.CallByName(json, "presentationId", VbGet)
        End With
    End Select
  End With
  CreateNewPresentation = presentation_id
End Function

Private Function GetAuthorizationCode(ByVal scopes As String) As String
'Authorization Code取得
  Dim ie As Object
  Dim url As String
  Dim iptCode As Object
  Dim auth_code As String
  Const READYSTATE_COMPLETE = 4
  
  '初期化
  Set ie = Nothing: Set iptCode = Nothing
  
  url = "https://accounts.google.com/o/oauth2/auth?" & _
        "client_id=" & client_id & _
        "&redirect_uri=" & redirect_uri & _
        "&scope=" & scopes & _
        "&response_type=" & response_type
  Set ie = CreateObject("InternetExplorer.Application")
  With ie
    .Visible = True
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Width = 600
    .Height = 480
    .Navigate url
    
    '承認待ち
    Do
      DoEvents
    Loop While InStr(LCase(.LocationURL), "accounts.google.com/o/oauth2/approval") < 1
    
    'Authorization Code取得待ち
    On Error Resume Next
    Do
      Set iptCode = .Document.getElementById("code")
      DoEvents
    Loop While iptCode Is Nothing
    On Error GoTo 0
    auth_code = iptCode.Value
    
    'ログアウト
    .Navigate "https://accounts.google.com/Logout"
    While .Busy Or .readyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    .Quit
  End With
  GetAuthorizationCode = auth_code
End Function

Private Function GetAccessToken(ByVal auth_code As String) As String
'Access Token取得
  Dim access_token As String
  Dim res As String
  Dim json As Object
  Dim dat As Variant
  
  dat = "code=" & auth_code & _
        "&client_id=" & client_id & _
        "&client_secret=" & client_secret & _
        "&redirect_uri=" & redirect_uri & _
        "&grant_type=" & grant_type
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", "https://accounts.google.com/o/oauth2/token", False
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send dat
    Select Case .Status
      Case 200:
        res = "(" & .responseText & ")"
        With CreateObject("ScriptControl")
          .Language = "JScript"
          Set json = .Eval(res)
          If Not json Is Nothing Then access_token = VBA.CallByName(json, "access_token", VbGet)
        End With
    End Select
  End With
  GetAccessToken = access_token
End Function

実行画面

上記コードを実行すると、Internet Explorerが立ち上がるので、Google アカウントでログインします。

アクセスの許可を求められるので、「許可」ボタンをクリックします。

問題なく処理が実行されると、新しいプレゼンテーションが作成され、そのID(presentationId)がメッセージボックスで表示されます。

おわりに

以上のように、VBAマクロからGoogle スライドで新規プレゼンテーションを作成できることが確認できました。
ただ、Slides APIを使ってテキスト編集やシェイプの追加等もできるのですが、JSON形式で取り扱うことになるため、VBAマクロで処理するのはツラいです。

VBAとGoogle APIの連携という、茨の道に興味がある方は是非お試しいただきたいのですが、そうでない方は、素直にGoogle Apps Scriptを使った方が良いだろうと思います
(ここまで書いておいて何ですが・・・)

また、今回のマクロはPowerPointマクロとして動作確認を行いましたが、アプリケーションに依存する書き方はしていないので、ExcelやWordといった、他のOfficeアプリケーションからでも実行できます。

参考Webページ

関連記事

  1. Office関連

    [Excel Services ECMAScript]アクティブなシート名を取得する。

    埋め込んだExcelワークブックのアクティブなシート名を取得するコード…

  2. Excel

    「Excel VBAの神様 ボクの人生を変えてくれた人」(大村あつし著)レビュー

    ※ 下記レビューはあくまでも個人的な感想です。2015年9…

  3. Excel

    アドインやテンプレートのバージョンチェックを行うVBAマクロ

    色々なアプリケーションに実装されている、「最新バージョンの確認」機能、…

  4. Excel

    VBAからRegistration-Freeで.NETベースのDLLを呼び出す方法

    C#製のDLLをVBAから呼び出すのにいちいちRegAsmするのも面倒…

  5. Office アドイン

    Office 用アプリはソースコードが丸見え!?

    サーバーサイドの処理はともかくとして、Officeドキュメントにアクセ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP