今回は選択した図の下にテキストボックスを追加するマクロを紹介します。
動作としては、リボン上にあるEditBox内に入力したテキストが選択した図や表の下真ん中に、テキストボックスとして追加されます。
リボン上のEditBoxの作り方については、下記のサイトさんを参考にされて頂いています。
では、以下コードになります。(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について
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の編集については過去記事を参考にして下さい。
VBAのコードはPowerPointを開いてAlt+F11でVBA画面を出し、"挿入→標準モジュール"で標準モジュールを追加し、貼りつけて下さい。
今回の記事は図の下に説明や図1とか入れる機会があったので、こんなのがあると便利かなーと思い作りました。
EditBoxの初期テキストや追加されるテキストのフォント等をいじれば、使い勝手がよくると思います。
終わりです。ありがとうございました。
こんな記事も書いてます。