Office関連

YouTube動画挿入アドイン for PowerPoint

前回の記事でPowerPoint 2013でYouTubeの動画が挿入できない問題と、その問題を解決するためのマクロを紹介しましたが、マクロに慣れていない方にとっては作業が難しい面もありますので、PowerPointでYouTubeの動画を挿入するためのアドイン(フリーソフト)を作成しました(PowerPoint 2010/2013 に対応)。

ファイルのダウンロード

ファイルはZip形式で圧縮していますので、Lhaplus等の圧縮解凍ソフトで解凍してからお使いください。

※ 当アドインの設定方法については付属の「readme.pdf」ファイルをご参照ください。

■ 使い方

PowerPointで当アドインを設定すると「挿入」タブに「YouTube 挿入」ボタンが追加されます。

Office2013_52_01

このボタンをクリックすると「ビデオID入力」ボックスが表示されるので、YouTube動画のIDを入力して「OK」ボタンをクリックします。

Office2013_52_02

※ ビデオIDは動画のURL[http://www.youtube.com/watch?v=***]の[***]部分にあたります。

Office2013_52_03

動画の確認メッセージが表示されるので、問題が無ければ「はい」ボタンをクリックします。

Office2013_52_04

動画を現在のスライドに挿入しました。」とのメッセージが表示され、選択中のスライドに動画が挿入されれば作業終了です。スライドショーを実行して動画の再生を確認してください。

Office2013_52_05

Office2013_52_06

※ 動画の挿入には時間が掛かる場合があります。

今後YouTubeやPowerPointの仕様変更に伴って、アドインが動作しなくなる可能性はありますが、2013/9/5 現時点ではとりあえず動作しますので、興味がある方は是非ご利用ください。

また、当アドインのVBAコードとリボンXMLは下記になりますので、当ツールをカスタマイズしたい方は下記コードをご利用ください。

・VBAコード

'YouTube動画をアクティブなスライドに挿入するPowerPointマクロ
'PowerPoint 2010/2013対応
'@kinuasa

Option Explicit

Public Sub btnYouTubeInsert_onAction(control As IRibbonControl)
  Call InsertYouTubeVideoExec
End Sub

Private Sub InsertYouTubeVideoExec()
  Dim VideoID As String
  Dim title As String
  
  title = "" '初期化
  VideoID = VBA.InputBox("YouTube動画のビデオIDを入力してください。" & vbCrLf & vbCrLf & _
                  "※ ビデオID:動画のURL[http://www.youtube.com/watch?v=***]の[***]部分", "ビデオID入力")
  If StrPtr(VideoID) = 0 Or Len(Trim(VideoID)) < 1 Then Exit Sub
  title = GetYouTubeVideoTitle(VideoID)
  If Len(Trim(title)) < 1 Then Exit Sub
  If MsgBox("挿入しようとしている動画は" & vbCrLf & vbCrLf & title & vbCrLf & vbCrLf & "で良いですか?", vbYesNoCancel + vbQuestion + vbSystemModal) = vbYes Then
    InsertYouTubeVideo VideoID
    MsgBox "動画を現在のスライドに挿入しました。", vbInformation + vbSystemModal
  End If
End Sub

Private Sub InsertYouTubeVideo(ByVal VideoID As String)
'ビデオIDを指定してYouTube動画をアクティブなスライドに挿入する
  Dim sld As PowerPoint.Slide
  Dim embed As String
  
  Set sld = Nothing '初期化
  Set sld = GetActiveSlide(ActivePresentation)
  If Not sld Is Nothing Then
    embed = "<object><param name=""movie"" value=""http://www.youtube.com/v/" & VideoID & "&amp;version=2"" /></object>"
    sld.Shapes.AddMediaObjectFromEmbedTag embed
  End If
End Sub

Private Function GetYouTubeVideoTitle(ByVal VideoID As String) As String
'YouTube動画のタイトルを取得
  Dim url As String
  Dim ret As String
  Dim s As String
  Dim n As Object
  
  ret = "": s = "": Set n = Nothing '初期化
  url = "http://gdata.youtube.com/feeds/api/videos/" & VideoID
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
    .Send
    If .Status = 200 Then s = .responseText 'responseXMLだと上手くいかなかったのでresponseText使用
  End With
  If Len(Trim(s)) > 0 Then
    With CreateObject("MSXML2.DOMDocument")
      .async = False
      If .LoadXML(s) Then
        Set n = .SelectSingleNode("/entry/title")
        If Not n Is Nothing Then
          ret = n.Text 'title要素の内容取得
        End If
      End If
    End With
  End If
  On Error GoTo 0
  GetYouTubeVideoTitle = ret
End Function

Private Function GetActiveSlide(ByVal p As Presentation) As Slide
'アクティブなスライドを取得
  Dim ret As Slide
  
  Set ret = Nothing '初期化
  On Error Resume Next
  Set ret = p.Slides.FindBySlideID(p.Windows(1).Selection.SlideRange.SlideID)
  On Error GoTo 0
  Set GetActiveSlide = ret
End Function

・リボンXML

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <tabs>
      <tab idMso="TabInsert">
        <group id="grpYouTubeInsert" label="YouTube 挿入" insertAfterMso="GroupInsertMediaClips" screentip="YouTubeの動画挿入" supertip="YouTubeの動画を挿入します。">
          <!-- image by : Erlen Masson - http://erlen.co.uk/ -->
          <button id="btnYouTubeInsert" label="YouTube 挿入" size="large" image="YouTubeIcon" onAction="btnYouTubeInsert_onAction" screentip="YouTubeの動画挿入" supertip="YouTubeの動画を現在のスライドに挿入します。" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

■ 関連Webページ

・PowerPoint 2013 で YouTube から動画を挿入したい【対処編】
http://snow-white.cocolog-nifty.com/first/2013/09/powerpoint-20-2.html

関連記事

  1. Office関連

    [PowerShell]iTextSharpを使ってPDFファイルを結合する

    mougにあった質問「2つのPDFファイルを結合するには」の回答用に書…

  2. リボン関連

    PowerShellからリボンUIを呼ぶ方法

    下記記事で簡易的なUIとして手軽なHTAを使いました。…

  3. Office関連

    PowerPoint 2013ではプレゼンテーションをmp4形式で保存できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  4. Office関連

    RESAS-APIをVBAから呼び出す方法

    下記記事の通り「地域経済分析システム RESAS」のAPIが公開された…

  5. リボン関連

    Office Ribbon Editorはウィルス?

    私のHP「Office Ribbon Editorの紹介」でも紹介して…

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP