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

ホーム
Office関連, リボン関連, PowerPoint
スライドショー(ウィンドウ表示)実行中にペン機能を使うためのPowerPointマクロ

2014.07.10

スライドショー(ウィンドウ表示)実行中にペン機能を使うための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

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