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

    外部アプリケーションのコンボボックスの内容を取得するVBAマクロのサンプル

    Q&Aサイトに下記質問がありました。(この質問も何となく似たような…

  2. アイコン一覧

    Office 2013 アイコン一覧(Q)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    Wordマクロで文字数を取得する方法をまとめてみました。

    「蛍光ペンでマークした部分の文字数をカウントするWordマクロ」で蛍光…

  4. Office関連

    PHPPresentationを使ってPHPからPowerPointファイルを出力してみる。

    久しぶりにPHPOfficeを覗いてみたら「PHPPresentati…

  5. Office関連

    文書内の単語を単語ごとにカウントするWordマクロ

    Wordsコレクションを使って文書内の単語を列挙し、各単語がそれぞれい…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP