Office関連

スライドショー(ウィンドウ表示)実行中にペン機能を使うためのPowerPointマクロ

Microsoft Communityに「スライドショー(ウィンドウ表示)実行中にペン機能を使いたい」という質問がありました。

・「出席者として参照する(ウィンドウ表示)」のスライドショーでペンツールを使用する方法
http://answers.microsoft.com/thread/a3afd66e-9e00-487c-aa9d-2834317d4fe1

たしかにスライドショーの設定で、種類を「出席者として参照する (ウィンドウ表示)(B)」にしていると、右クリックメニューに矢印や蛍光ペンといったポインター オプションは表示されません。

Ctrl + PやCtrl + Aといったショートカットキー(ショートカット キーを使用してプレゼンテーションを行う 参照)でポインターを切り替えようとしても、ウィンドウ表示の場合は上手く行きません。

・・・というわけで、マクロでの処理を考えてみました。

※ 下記コードはPowerPoint 2010以降のバージョンが対象となります。2007以下では動作しません。

・リボンXML

<?xml version="1.0" encoding="utf-8"?>
<customUI onLoad="Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <contextMenus>
    <contextMenu idMso="ContextMenuShowBrowse">
      <gallery idMso="InkColorPicker" label="インクの色(&amp;C)" />
    </contextMenu>
  </contextMenus>
</customUI>

・VBAコード

Option Explicit

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
  AddPointerOption
End Sub

Private Sub AddPointerOption()
'スライド ショー ツールバーに「ポインター オプション」追加
  Const CtrlCaption As String = "ポインター オプション(&O)"
  
  DelControl Application.CommandBars("Slide Show Browse"), CtrlCaption
  With Application.CommandBars("Slide Show Browse").Controls.Add(Type:=msoControlPopup, Temporary:=True)
    .BeginGroup = True
    .Caption = CtrlCaption
    If Val(Application.Version) >= 15 Then
      .Controls.Add Id:=22718 'レーザー ポインター(&L)
    End If
    .Controls.Add Id:=2906 '矢印(&A)
    .Controls.Add Id:=9252 'ペン(&P)
    .Controls.Add Id:=9253 '蛍光ペン(&H)
    .Controls.Add(Id:=7884).BeginGroup = True '消しゴム(&R)
    .Controls.Add Id:=2901 'スライド上のインクをすべて消去(&E)
    '.Controls.Add Id:=31300 '矢印のオプション(&O)
    With .Controls.Add(Type:=msoControlPopup, Temporary:=True)
      .BeginGroup = True
      .Caption = "矢印のオプション(&O)"
      With .Controls.Add(Type:=msoControlButton, Temporary:=True)
        .Caption = "自動(&U)"
        .OnAction = "SetPointerOption"
        .Parameter = ppSlideShowPointerAutoArrow
      End With
      With .Controls.Add(Type:=msoControlButton, Temporary:=True)
        .Caption = "表示(&V)"
        .OnAction = "SetPointerOption"
        .Parameter = ppSlideShowPointerArrow
      End With
      With .Controls.Add(Type:=msoControlButton, Temporary:=True)
        .Caption = "常に表示しない(&H)"
        .OnAction = "SetPointerOption"
        .Parameter = ppSlideShowPointerAlwaysHidden
      End With
    End With
  End With
End Sub

Public Sub SetPointerOption(Optional ByVal dummy As Long = 0)
  On Error Resume Next
  Application.SlideShowWindows(1).View.PointerType = _
  Application.CommandBars.ActionControl.Parameter
End Sub

Private Sub DelControl(ByRef TargetCommandBar As Office.CommandBar, _
                       ByVal TargetControlCaption As String)
'指定したコマンドバーからコントロールを削除
  Dim ctrl As Office.CommandBarControl
  
  For Each ctrl In TargetCommandBar.Controls
    If ctrl.Caption = TargetControlCaption Then
      ctrl.Delete
    End If
  Next
End Sub

上記コードは、ウィンドウ表示スライドショー実行中の右クリックメニュー、もしくは画面右下の「メニュー」に自力で「ポインター オプション」を追加するものです。

AddPointerOption_01

AddPointerOption_02

インクの色」を追加するために、わざわざリボンのカスタマイズまで行っていますが、とりあえずはこれで目的を達成できるようになりました。

実際に上記マクロを使う場合はアドイン化した方が良いかと思います。
自分でリボンをカスタマイズしてコードを貼り付けて・・・、という作業が面倒な方は下記リンクからアドインファイルをダウンロードしてお使いください。

アドインのダウンロードはコチラから

関連記事

  1. Windows 10

    SeleniumBasic(Selenium VBA)がMicrosoft Edgeに対応しました。…

    言わずと知れたWebブラウザーの自動制御ツール「Selenium」のV…

  2. Office関連

    フッターにページ番号と総ページ数を挿入するWordマクロ

    以前書いた、フッターに「ページ番号 / 総ページ数」を挿入するWord…

  3. Office関連

    テキストボックスの中にある表を操作するWordマクロ

    Yahoo!知恵袋で、「Wordマクロでテキストボックスの中にある表の…

  4. Office関連

    VBAでTTSエンジンの各種情報を列挙する

    今回はTTSエンジンの各種情報を列挙するマクロを紹介します。Mic…

  5. Office アドイン

    [Office用アプリ]サポートページにある資料へのリンクをまとめてみました。

    MicrosoftのサポートページにあるOffice 用アプリや関連技…

  6. Office関連

    ExcelのWebクエリからのアクセス情報

    mougに面白い質問がありました。・Querytables.a…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP