Word VBA to check every object in the doc is smaller than page margin

Question

I need to check every object (table, figure) in a large document and ensure they do not go outside of margins? i.e., compare each object's width with page width... then flag with <TOO_LARGE> on top of every page for easy search.

Thanks in advance! BT

I searched on the web and can't find anything to based off.

Answer 1

Because flag with <TOO_LARGE> on top of every page will change the original content, I bookmark those objects instead. You can try it first:

Only one kind PageSetup:

Sub CheckObjectMargins()
    Dim doc As Word.Document, rng As Range, i As Long, c As Word.cell
    Dim obj As Object, objWidth As Single
    Dim objs As New VBA.Collection
    Dim pageWidth As Long
    Dim tooLarge As Boolean, ur As UndoRecord
    
    Set ur = Word.Application.UndoRecord
    ur.StartCustomRecord "CheckObjectMargins"
    Set doc = ActiveDocument
    
    ' Get the page width.
    pageWidth = doc.PageSetup.pageWidth - doc.PageSetup.LeftMargin - doc.PageSetup.RightMargin
    
    ' Loop through all the inline shapes in the document.
    For Each obj In doc.InlineShapes
    
        ' Check if the object's width is greater than the page width.
        tooLarge = obj.Width > pageWidth
        
        ' If the object is too large, flag it with a bookmark.
        If tooLarge Then
            objs.Add obj
        End If
    
    Next obj
    
    For Each obj In doc.Tables
        ' Check if the object's width is greater than the page width.
        If Not obj.PreferredWidth = 9999999 Then
            tooLarge = obj.PreferredWidth > pageWidth
        Else
            For Each c In obj.Range.Cells
                If i = 0 Then
                    i = c.RowIndex
                Else
                    If i < c.RowIndex Then
                        Exit For
                    End If
                End If
                objWidth = objWidth + c.Width
            Next c
        End If
        
        tooLarge = objWidth > pageWidth
        
        ' If the object is too large, flag it with a bookmark.
        If tooLarge Then
            objs.Add obj
        End If
        objWidth = 0: i = 0
    Next obj
    
    For Each obj In doc.Shapes
        ' Check if the object's width is greater than the page width.
        tooLarge = obj.Width > pageWidth
        
        ' If the object is too large, flag it with a bookmark.
        If tooLarge Then
            objs.Add obj
        End If
    
    Next obj
    i = 0
    For Each obj In objs
        Set rng = obj.Range
        i = i + 1
        If rng.Information(wdInContentControl) Then
            If rng.End + 1 < doc.Range.End Then
                rng.SetRange rng.End + 1, rng.End + 1
            Else
                rng.SetRange rng.Start - 1, rng.Start - 1
            End If
        End If
        ' If the object is too large, flag it with a bookmark.
        rng.Bookmarks.Add "TOO_LARGE" & i, rng
        
    Next obj
    ur.EndCustomRecord
End Sub

Multiple PageSetups:

... One other question, how to ensure that the pagewidth is checked in every section break (i.e., I have portrait/landscape/portrait/landscape page orientation within the same document)... I noticed that every object in landscape orientation is flagged. I tried to add "For Each Sec In doc.Section" to have pagewidth re-calculated, but it is still using the portrait one to check for the entire document...

Sub CheckObjectMargins()
    Dim doc As Word.Document, rng As Range, i As Long, c As Word.cell
    Dim obj As Object, objWidth As Single
    Dim objs As New VBA.Collection
    Dim pageWidth As Long
    Dim tooLarge As Boolean, ur As UndoRecord
    Dim sec As Word.Section, sRng As Range
    
    Set ur = Word.Application.UndoRecord
    ur.StartCustomRecord "CheckObjectMargins"
    Set doc = ActiveDocument
    Set sRng = selection.Range.Duplicate
    
    For Each sec In doc.Sections
        
        ' Get the page width.
        'pageWidth = doc.PageSetup.pageWidth - doc.PageSetup.LeftMargin - doc.PageSetup.RightMargin
        pageWidth = sec.PageSetup.pageWidth - sec.PageSetup.LeftMargin - sec.PageSetup.RightMargin
        
        ' Loop through all the inline shapes in the document.
        For Each obj In sec.Range.InlineShapes
        
            ' Check if the object's width is greater than the page width.
            tooLarge = obj.Width > pageWidth
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                objs.Add obj
            End If
        
        Next obj
        
        For Each obj In sec.Range.Tables
            ' Check if the object's width is greater than the page width.
            If Not obj.PreferredWidth = 9999999 Then
                tooLarge = obj.PreferredWidth > pageWidth
            Else
                For Each c In obj.Range.Cells
                    If i = 0 Then
                        i = c.RowIndex
                    Else
                        If i < c.RowIndex Then
                            Exit For
                        End If
                    End If
                    objWidth = objWidth + c.Width
                Next c
            End If
            
            tooLarge = objWidth > pageWidth
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                objs.Add obj
            End If
            objWidth = 0: i = 0
        Next obj
        
        For Each obj In sec.Range.ShapeRange
            ' Check if the object's width is greater than the page width.
            tooLarge = obj.Width > pageWidth
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                objs.Add obj
            End If
        
        Next obj
        
    Next sec
    
    i = 0
    For Each obj In objs
        i = i + 1
        If VBA.TypeName(obj) = "Shape" Then
            ' If the object is too large, flag it with a bookmark.
            obj.Select
            doc.Bookmarks.Add "TOO_LARGE" & i, selection.Range
    
        Else
            Set rng = obj.Range
            If rng.Information(wdInContentControl) Then
                If rng.End + 1 < doc.Range.End Then
                    rng.SetRange rng.End + 1, rng.End + 1
                Else
                    rng.SetRange rng.Start - 1, rng.Start - 1
                End If
            End If
            ' If the object is too large, flag it with a bookmark.
            rng.Bookmarks.Add "TOO_LARGE" & i, rng
        End If
    
        
    Next obj
    
    
    selection.SetRange sRng.Start, sRng.End
    ur.EndCustomRecord
    
End Sub

Multiple PageSetups and tables wider:

Question though... just for tables, is there a way to extract tables left/right locations so I can compare against page margins (i.e., table started at -0.3 in of the page... but there is a 0.5 left margin)... same goes with the right...

Sub CheckObjectMargins()
    Dim doc As Word.Document, rng As Range, i As Long, c As Word.cell
    Dim obj As Object, objWidth As Single
    Dim objs As New VBA.Collection
    Dim pageWidth As Long
    Dim tooLarge As Boolean, ur As UndoRecord
    Dim sec As Word.Section, sRng As Range
    
    Dim tbLeft As Single
    Const table_started_at As Single = 0.3
    Const table_started_at_R As Single = 0.3
    
    Set ur = Word.Application.UndoRecord
    ur.StartCustomRecord "CheckObjectMargins"
    Set doc = ActiveDocument
    Set sRng = selection.Range.Duplicate
    
    For Each sec In doc.Sections
        
        ' Get the page width.
        'pageWidth = doc.PageSetup.pageWidth - doc.PageSetup.LeftMargin - doc.PageSetup.RightMargin
        pageWidth = sec.PageSetup.pageWidth - sec.PageSetup.LeftMargin - sec.PageSetup.RightMargin
        
        ' Loop through all the inline shapes in the document.
        For Each obj In sec.Range.InlineShapes
        
            ' Check if the object's width is greater than the page width.
            tooLarge = obj.Width > pageWidth
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                objs.Add obj
            End If
        
        Next obj
        
        For Each obj In sec.Range.Tables
            ' Check if the object's width is greater than the page width.
            If Not obj.PreferredWidth = 9999999 Then
                tooLarge = obj.PreferredWidth > pageWidth
            Else
                For Each c In obj.Range.Cells
                    If i = 0 Then
                        i = c.RowIndex
                    Else
                        If i < c.RowIndex Then
                            Exit For
                        End If
                    End If
                    objWidth = objWidth + c.Width
                Next c
                tooLarge = objWidth > pageWidth
            End If
            
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                tbLeft = obj.Range.Information(wdHorizontalPositionRelativeToPage)
                obj.Range.Select
                If tbLeft < InchesToPoints(table_started_at) Or _
                    pageWidth - (tbLeft + objWidth) < table_started_at_R Then
                    objs.Add obj
                End If
            End If
            objWidth = 0: i = 0
        Next obj
        
        For Each obj In sec.Range.ShapeRange
            ' Check if the object's width is greater than the page width.
            tooLarge = obj.Width > pageWidth
            
            ' If the object is too large, flag it with a bookmark.
            If tooLarge Then
                objs.Add obj
            End If
        
        Next obj
        
    Next sec
    
    i = 0
    For Each obj In objs
        i = i + 1
        If VBA.TypeName(obj) = "Shape" Then
            ' If the object is too large, flag it with a bookmark.
            obj.Select
            doc.Bookmarks.Add "TOO_LARGE" & i, selection.Range
    
        Else
            Set rng = obj.Range
            If rng.Information(wdInContentControl) Then
                If rng.End + 1 < doc.Range.End Then
                    rng.SetRange rng.End + 1, rng.End + 1
                Else
                    rng.SetRange rng.Start - 1, rng.Start - 1
                End If
            End If
            ' If the object is too large, flag it with a bookmark.
            rng.Bookmarks.Add "TOO_LARGE" & i, rng
        End If
    
        
    Next obj
    
    
    selection.SetRange sRng.Start, sRng.End
    ur.EndCustomRecord
    
End Sub

After marking them all, you can use Ctrl + Shift + F5 to navigate these bookmarks and go to every too-large one by double-clicking on a bookmark's name or select one then click go-to button. like this: