Office関連

代替テキストを削除するPowerPointマクロ

PowerPointの図やSmartArt、グループやグラフといった視覚的なコンテンツには、画面を見ることができないユーザー向けに、そのコンテンツが何なのかを示す「代替テキスト」(AlternativeText, alt text)を設定することができます。

PDFに変換するとき等、この代替テキストを残しておきたくない場合もあるので、一括削除するマクロを書いてみました。

Option Explicit

Public Sub DelAllAltText()
'代替テキストを一括削除
  Dim prs As PowerPoint.Presentation
  Dim sld As PowerPoint.Slide
  Dim shp As PowerPoint.Shape
  Dim tmp As PowerPoint.PpViewType
  
  Set prs = ActivePresentation
  
  '表示モードを「標準」にして処理実行
  If SlideShowWindows.Count > 0 Then _
    prs.SlideShowWindow.View.Exit 'スライドショー表示になっていたら解除
  With ActiveWindow
    tmp = .ViewType 'ウィンドウの表示モード記憶
    .ViewType = ppViewNormal
  End With
  
  For Each sld In prs.Slides
    For Each shp In sld.Shapes
      DelAltText shp
    Next
  Next
  
  ActiveWindow.ViewType = tmp 'ウィンドウの表示モードを元に戻す
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Sub DelAltText(ByVal TargetShape As PowerPoint.Shape)
'代替テキストの削除
  Dim grpShps As PowerPoint.GroupShapes
  Dim shp As PowerPoint.Shape
  
  On Error Resume Next
  Set grpShps = TargetShape.GroupItems
  On Error GoTo 0
  If grpShps Is Nothing Then
    If Len(Trim(TargetShape.AlternativeText)) > 0 Then
      TargetShape.AlternativeText = ""
    End If
    If Len(Trim(TargetShape.Title)) > 0 Then
      TargetShape.Title = ""
    End If
  Else
    For Each shp In grpShps
      DelAltText shp
    Next
  End If
End Sub

上記マクロを実行すると、すべてのスライド上にある図、SmartArt、グループ、グラフ、埋め込みオブジェクト、ビデオといったコンテンツから、代替テキストを削除します。

同様のマクロは下記サイトでもすでに取り上げられています。

関連記事

  1. Office アドイン

    [Officeアドイン]Excel Custom functionsのデバッグ方法

    前回の記事でExcelの新たな機能「Custom functions」…

  2. Office関連

    VALUE DOMAINで管理しているドメインをOffice 365で使用する。

    Office 365をセットアップすると設定される初期ドメイン「onm…

  3. Windows 10

    【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)

    「Microsoft Edge VBA 操作」こういったキーワード検索…

  4. Office関連

    コントロールID 一覧(Office 2013)

    2013/03/25 追記:Office 2013のコントロールI…

  5. Office関連

    ディスプレイのサイズを取得するVBAマクロ

    「VBA ディスプレイ 幅 高さ」といったキーワード検索でのアクセスが…

  6. Microsoft Teams

    Microsoft Teamsでタブの構築を試してみました。

    下記記事の通り、Office 365に新たなコラボレーションツール「M…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP