Word (VBA)

Word VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Word 2016)
Word文書の画像や直線を削除したい
投稿日時: 20/02/27 10:47:53
投稿者: gorby

以前にPowerpointファイルの画像や直線を削除するマクロを下記のとおり作成しました。
これをWord文書用に作り替えたいのですが、どう直せば良いでしょうか?
slideオブジェクトやActivePresentationオブジェクトを変更しなければならないのはわかりますが、どう変更すればよいかわかりません。ご存知の方、教授をお願いします!
 
 
--<Start of code>---
Sub Delete()
 
  Dim s As Shape 'sはshapeオブジェクトを入れる変数
 Dim c As Collection 'cはコレクション
 Dim start_slide As Integer 'start_slideはスライド番号1を入れる定数
 Dim i As Integer 'iはスライド番号を入れる変数
 
  start_slide = 1
 For i = start_slide To ActivePresentation.Slides.Count
  Set c = New Collection
  For Each s In ActivePresentation.Slides(i).Shapes '変数sにアクティブスライド番号のすべてのshapeオブジェクトを入れる。
   c.Add s
  Next
  For Each s In c
    Select Case s.Type
                 Case msoPicture
                    s.Delete
                 Case msoLine
                    s.Delete
                 Case Else
                     '何もしない
    End Select
  
  Next
 Next
--<End of code>---
  
  
  
 End Sub
 
 
 
 
 

回答
投稿日時: 20/02/27 16:56:27
投稿者: sk

引用:
ファイルの画像や直線を削除するマクロ

(標準モジュール)
---------------------------------------------------------
Sub DeleteAllLinesAndPictures()
 
    Application.ScreenUpdating = False
     
    Dim i As Long
     
    '(インラインでない)全ての図形の削除
    Dim shp As Word.Shape
    For i = ActiveDocument.Shapes.Count To 1 Step -1
        Set shp = ActiveDocument.Shapes(i)
        Select Case shp.Type
            '直線,図、リンクされた図
            Case msoLine, msoPicture, msoLinkedPicture
                shp.Delete
            Case Else
                '何もしない
        End Select
        Set shp = Nothing
    Next
     
    '全てのインライン図形の削除
    Dim ishp As Word.InlineShape
    For i = ActiveDocument.InlineShapes.Count To 1 Step -1
        Set ishp = ActiveDocument.InlineShapes(i)
        Select Case ishp.Type
            '図、リンクされた図
            Case wdInlineShapePicture, _
                 wdInlineShapePictureHorizontalLine, _
                 wdInlineShapeLinkedPicture, _
                 wdInlineShapeLinkedPictureHorizontalLine
                ishp.Delete
            Case Else
                '何もしない
        End Select
        Set ishp = Nothing
    Next
     
    Application.ScreenUpdating = True
     
End Sub
---------------------------------------------------------
 
以上のようなコードを実行なさればよろしいのではないかと。

トピックに返信