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. Office関連

    Office製品の開発者用リファレンス(ダウンロード版)

    Docs.comでまとめていたリンクなんですが、来月15日にすべて廃止…

  2. Office関連

    古い形式のWordテンプレートを新しい形式に一括変換するVBScript

    古い形式のWordテンプレート(dot)を新しい形式(dotx,dot…

  3. Office関連

    1MBのWordファイルって何文字くらい?

    ZIP圧縮されたOOXML形式のWordファイルって1MBだと何文字分…

  4. Office関連

    アラビア文字かどうかを判別するWordマクロ

    以前mougの質問用に書いたコードが出てきたので、一部修正しました。…

  5. Office アドイン

    Visio JavaScript APIで遊んでみました。

    前回の記事でプレビュー版がリリースされた「Visio JavaScri…

  6. Office関連

    SkyDriveの同期フォルダーのパスを取得するWordマクロ

    無料で使える便利なクラウドストレージ「SkyDrive」にはローカルフ…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP