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

PowerPoint 2013でYouTubeの動画を挿入する。前のページ

[Office用アプリ]アプリ開発コンテスト・受賞者発表次のページ

関連記事

  1. Office関連

    起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(DOM編)

    前回の記事で、UI Automationを使って起動中のMicroso…

  2. アイコン一覧

    Office 2013 アイコン一覧(W)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    右クリックメニューを非表示にするExcelマクロ

    Answersに図形を右クリックしたときのメニューをマクロで非表示にし…

  4. Office関連

    代理人アクセスによって予定を追加するOutlookマクロ

    先日久々にmougの質問に回答しました。マクロを使って、Exc…

  5. Office関連

    [Excel Services ECMAScript]アクティブセルが変更されたときのイベントを利用…

    埋め込んだExcelワークブックの、アクティブセルが変更されたときのイ…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP