Results 1 to 5 of 5
  1. #1
    New Lounger
    Join Date
    Nov 2010
    Location
    Ramat Gan, Israel
    Posts
    3
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Windows 7 Home Premium

    Office 2007 Enterprise SP2

    VBA 6.5

    In a Word 2007 document (attached) that includes tables with pictures in some of their cells, I've recorded a macro that goes to the next picture, deletes it, and fills its cell with grey shade (see delailed steps recorded hereinafter).

    I'd like to modify the code produced (see hereinafter) in such a way, that it will repeat that routine as long as there still exist pictures in the document. Once there are no more pictures, it will go to the beginning of the document (Ctrl-Home) and stop.

    Could anybody please suggest the additional code lines to be inserted in order to achieve it?

    Steps recorded in the macro:

    (before recording started, the cursor was at the beginning of the document)

    Start recording and name the macro (say, XWd_Cells)

    • Click F5 key
    • In the Go To tab, under Go to what select Graphic
    • Click Next and then click Close
    • Click Delete key twice.
    • In the Ribbon, under Layout, select Properties
    • In the Table tab click Borders and Shading…
    • In the Shading tab -
      • Under Fill select a shade, say, dark grey (at bottom of leftmost shades column)
      • Under Apply to select Cell
      • Click OK
    • Click OK
    Stop macro recording

    Code Produced
    Code:
     Sub XWd_Cells()
     '
     ' XWd_Cells Macro
     '
     '
     	Selection.GoTo What:=wdGoToGraphic, Which:=wdGoToNext, Count:=1, Name:=""
     	Selection.Find.ClearFormatting
     	With Selection.Find
     	.Text = ""
     	.Replacement.Text = ""
     .Forward = True
     	.Wrap = wdFindContinue
     	.Format = False
     	.MatchCase = False
     	.MatchWholeWord = False
     	.MatchKashida = False
     	.MatchDiacritics = False
     	.MatchAlefHamza = False
     	.MatchControl = False
     	.MatchWildcards = False
     	.MatchSoundsLike = False
     	.MatchAllWordForms = False
     	End With
     	Selection.Delete Unit:=wdCharacter, Count:=1
     	Selection.Delete Unit:=wdCharacter, Count:=1
     	With Selection.Cells.Shading
     .Texture = wdTextureNone
     	.ForegroundPatternColor = wdColorAutomatic
     	.BackgroundPatternColor = -603946753
     	End With
     	With Options
     	.DefaultBorderLineStyle = wdLineStyleOutset
     	.DefaultBorderLineWidth = wdLineWidth075pt
     .DefaultBorderColor = 12237498
     	End With
     End Sub
    Attached Files Attached Files

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    This is a revised version of your code that will loop through a document from top to bottom. I wasn't able to test it in Word 2007 (and the background color doesn't work in Word 2003), so apologies in advance for any dysfunctionality.

    Code:
    Sub XWd_Cells2()
    ' Delete pictures and shade table cells they were in
    Dim strRangeVars As String
    With Selection
        ' Start at the top
        .HomeKey unit:=wdStory
        ' Loop so we get all the pictures
        Do
            ' Store Selection.Range information
            strRangeVars = .Range.Start & "|" & .Range.End
            .GoTo What:=wdGoToGraphic, Which:=wdGoToNext, Count:=1, Name:=""
            ' Check to see whether the insertion point moved, if not we're done
            If .Range.Start & "|" & .Range.End = strRangeVars Then Exit Do
            ' Delete picture -- not sure why there are two deletes, maybe only need one?
            .Delete unit:=wdCharacter, Count:=1
            .Delete unit:=wdCharacter, Count:=1
            ' Shade table cell
            If .Information(wdWithInTable) Then
                With .Cells.Shading
                    .Texture = wdTextureNone
                    .ForegroundPatternColor = wdColorAutomatic
                    .BackgroundPatternColor = -603946753
                End With
            End If
        Loop
        ' Return to top
        .HomeKey unit:=wdStory
    End With
    ' Set default border options (?)
    With Options
        .DefaultBorderLineStyle = wdLineStyleOutset
        .DefaultBorderLineWidth = wdLineWidth075pt
        .DefaultBorderColor = 12237498
    End With
    End Sub

  4. #3
    Platinum Lounger
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    3,630
    Thanks
    7
    Thanked 232 Times in 220 Posts
    dysfunctionality?!?

    cheers, Paul

  5. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,920
    Thanks
    0
    Thanked 194 Times in 177 Posts
    Hi RY,

    Welcome to the Lounge.

    Here's a simpler macro for you to try:
    Code:
    Sub Xwd_Cells()
    Application.ScreenUpdating = False
    Dim oTbl As Table, oCel As Cell
    With ActiveDocument
      For Each oTbl In .Tables
        For Each oCel In oTbl.Range.Cells
          With oCel.Range
            If .InlineShapes.Count > 0 Then
              With .InlineShapes
                While .Count > 0
                  .Item(1).Delete
                Wend
              End With
              With .Shading
                .Texture = wdTextureNone
                .ForegroundPatternColor = wdColorAutomatic
                .BackgroundPatternColor = wdColorGray50
              End With
            End If
          End With
        Next oCel
      Next oTbl
    End With
    Application.ScreenUpdating = True
    End Sub
    Note: Your code includes a routine to set the default table options, which doesn't really seem to have anything to do with processing the tables in question. With the code I've posted, all tables in the document are processed without you having to select anything and you are returned to wherever you were in the document when it's finished executing. And, in case you've somehow managed to get more than one 'picture' into a cell, I've included a loop to ensure they're all deleted. Finally, because the code doesn't use selections and turns screen updating off while it's running, it should be much faster than Jefferson's
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  6. #5
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,243
    Thanks
    202
    Thanked 796 Times in 729 Posts
    Macropod,

    Nicely done! Thumbs up from me.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


Posting Permissions

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