もめんの格闘日記

主にPowerPointを中心としたPCのTips的なものを書いています。

【PowerPointマクロ】選択した図の下にタイトル(テキストボックス)を追加するマクロ

f:id:momen40:20170115212421j:plain

今回は選択した図の下にテキストボックスを追加するマクロを紹介します。

動作としては、リボン上にあるEditBox内に入力したテキストが選択した図や表の下真ん中に、テキストボックスとして追加されます。

リボン上のEditBoxの作り方については、下記のサイトさんを参考にされて頂いています。

SuyamaSoft

では、以下コードになります。(PowerPoint2010で動作を確認しています)

 

リボンのcustom.xml

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="マクロタブ">
        <group id="Group1" label="タイトル追加" >
          <editBox id="EditBox1" label="テキスト:" supertip="図の下に追加するテキストを入力してください。" sizeString="MMMMMMMMMM" getText="EditBox_getText" onChange="EditBox_OnChange" />
          <button id="Button1" label=" テキスト追加 " imageMso="MacroPlay" size="normal" supertip="入力したテキストを図の下に追加します。"  onAction="Button_OnClick" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

 

onLoadについて

  • 定義したVBA上の関数でリボン上での初期処理が決まります
  • 定義した関数と同じVBA上での関数を同じ名前にして下さい

editBoxについて

  • labelでリボン上に表示されるボタン名が決まります
  • sizeStringでEditBoxの大きさを決めます
  • getTextで定義したVBA上での関数で初期値が決まります
  • onChangeで定義したVBA上での関数でEditBox内の値を取得します
  • supertipでマウスオンしたときに表示される説明が決まります

buttonについて

  • imageMsoでボタンのアイコンが決まります
  • onActionで定義したVBA上での関数でボタンを押したときの動作が決まります

 

VBAのコード

Option Explicit

Private myRibbon As IRibbonUI
Private Text As String

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Text = "図1-1"
  Set myRibbon = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  myRibbon.Invalidate ' リボンの表示を更新します。
End Sub

Sub EditBox_getText(control As IRibbonControl, ByRef returnedVal) ' editBoxに代入する
  returnedVal = Text
End Sub

Sub EditBox_OnChange(control As IRibbonControl, EditText As String) ' editBoxから取得する
  Text = EditText
End Sub

Sub Button_OnClick(control As IRibbonControl) ' テキストの追加
  Dim T As Single, L As Single, H As Single, W As Single
 
  With ActiveWindow.Selection
    If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then '何も選択されていない、スライドが選択されている場合
      MsgBox "図または表を選択して下さい。"
    ElseIf .ShapeRange.Type = msoPicture Or .ShapeRange.Type = msoLinkedPicture _
      Or .ShapeRange.Type = msoAutoShape Or .ShapeRange.Type = msoTable Then
      T = .ShapeRange.Top
      L = .ShapeRange.Left
      H = .ShapeRange.Height
      W = .ShapeRange.Width
      
      If Len(Text) > 0 Then
        With .SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, T + H, 10, 10)  'ここでのLeftとHeightとWidthは仮の値
          .TextEffect.Text = Text
          .TextEffect.Alignment = msoTextEffectAlignmentCentered 'テキストの中央揃え
          .TextEffect.FontSize = 14
          .TextFrame.TextRange.Font.Name = "Arial"
          .TextFrame.TextRange.Font.NameFarEast = "MS Pゴシック"

          .TextFrame.WordWrap = msoFalse 'テキストボックスの大きさを調整
          .Left = L + (W - .Width) / 2  'テキストボックスの位置を図、表の真ん中に移動
        End With
      End If
    Else
      MsgBox "図または表を選択して下さい。"
    End If
  End With
End Sub

コード長いです。以下補足説明です。

  • このコードでは図、オートシェイプ、表を選択した時にテキストを追加します
  • 選択した図などの位置、大きさを取得し、追加するテキストボックスの位置を調整しています
  • テキストボックスのLeftとHeightとWidthは、一旦仮の値を入れ、後から位置と大きさを決めています

 

リボンのカスタマイズ、custom.xmlの編集については過去記事を参考にして下さい。

マクロを実行するボタンを追加する方法(その1)

VBAのコードはPowerPointを開いてAlt+F11でVBA画面を出し、"挿入→標準モジュール"で標準モジュールを追加し、貼りつけて下さい。

 

今回の記事は図の下に説明や図1とか入れる機会があったので、こんなのがあると便利かなーと思い作りました。

EditBoxの初期テキストや追加されるテキストのフォント等をいじれば、使い勝手がよくると思います。

 

終わりです。ありがとうございました。

 

こんな記事も書いてます。

 

momen40.hatenablog.com

 

 

momen40.hatenablog.com