Results 1 to 2 of 2
  1. #1
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Code: Sub cmd_RemoveAllGraphics()

    <pre>Option Explicit
    Sub cmd_RemoveAllGraphics()
    ' Procedure : cmd_RemoveAllGraphics
    ' Description: Generic effort to strip all recognizable graphics from the active document.
    ' By: Chris Greaves Inc.
    ' Inputs: None
    ' Returns: None
    ' Assumes: Nothing
    ' Side Effects: None.
    ' Tested: By the calls shown below.
    Dim doc As Document
    Set doc = ActiveDocument
    Call boolClearAllGraphics(doc, "")
    Call lngRemoveShapes(doc)
    Call lngRemoveHyperlinks(doc)
    End Sub
    Function boolClearAllGraphics(doc As Document, strReplace As String) As Boolean
    ' Procedure : boolClearAllGraphics
    ' Description: Strip all Edit-Find graphics from the document.
    ' By: Chris Greaves Inc.
    ' Inputs: Document, replacement string (usually null)
    ' Returns: TRUE if any graphics were found
    ' Assumes: Nothing
    ' Side Effects: None.
    ' Tested: By the calls shown below.
    Documents(doc).Activate
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = "^g"
    .Replacement.Text = strReplace
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    boolClearAllGraphics = Selection.Find.Execute(Replace:=wdReplaceAll)
    'Sub TESTboolClearAllGraphics()
    'MsgBox boolClearAllGraphics(ActiveDocument, "")
    'End Sub
    End Function
    Function lngRemoveShapes(doc As Document) As Long
    ' Procedure : lngRemoveShapes
    ' Description: Strip all shape and inlineShapegraphics from the document.
    ' By: Chris Greaves Inc.
    ' Inputs: Document
    ' Returns: LONG count of shapes removed.
    ' Assumes: Nothing
    ' Side Effects: None.
    ' Tested: By the calls shown below.
    Documents(doc).Activate
    lngRemoveShapes = ActiveDocument.Shapes.Count + ActiveDocument.InlineShapes.Count
    Dim intShape As Integer
    ' We count down so as not to disturb the ordinal position of each shape in the collection.
    For intShape = ActiveDocument.Shapes.Count To 1 Step -1
    ActiveDocument.Shapes(intShape).Delete
    Next intShape
    ' We count down so as not to disturb the ordinal position of each shape in the collection.
    For intShape = ActiveDocument.InlineShapes.Count To 1 Step -1
    ActiveDocument.InlineShapes(intShape).Delete
    Next intShape
    'Sub TESTlngRemoveShapes()
    'MsgBox lngRemoveShapes(ActiveDocument)
    'End Sub
    End Function

    Function lngRemoveHyperlinks(doc As Document) As Long
    ' Procedure : lngRemoveHyperlinks
    ' Description: Strip all Hyperlink graphics from the document.
    ' By: Chris Greaves Inc.
    ' Inputs: Document
    ' Returns: LONG count of hyperlinks removed.
    ' Assumes: Nothing
    ' Side Effects: None.
    ' Tested: By the calls shown below.
    lngRemoveHyperlinks = 0
    Documents(doc).Activate
    ' We need to recognize Hyperlinks to files with graphic-like extensions.
    ' For this we would need my strBreakFileString function.
    ' {Hyperlink "../plaind2.gif"}
    ' {Hyperlink "../sylvia2.jpg"}
    'Sub TESTlngRemoveHyperlinks()
    'MsgBox lngRemoveHyperlinks(ActiveDocument)
    'End Sub
    End Function
    </pre>


  2. #2
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code: Sub cmd_RemoveAllGraphics()

    I detected a problem with my RemoveGraphics code. The MSN knowledge base isn't very helpful (pasted at foot of this post). By reading between the lines I sensed a problem with SELECTION so I have split one line of code into two lines; the first selects the object, the second deletes the selection.


    <pre>For intShape = activedocument.InlineShapes.Count To 1 Step -1
    activedocument.InlineShapes(intShape).Select ' used to be

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •