英文:
Word VBA to check every object in the doc is smaller than page margin
问题
我需要检查大型文档中的每个对象（表格、图形），确保它们不超出边距？即比较每个对象的宽度与页面宽度...然后在每页顶部标记为<TOO_LARGE>以便进行简单搜索。
提前感谢！
BT
我在网上搜索了，找不到可依据的信息。
英文:
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.
答案1
得分: 1
因为每页顶部都有带有<TOO_LARGE>标记的标志会改变原始内容，所以我会收藏这些对象。您可以首先尝试：
只有一种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
' 获取页面宽度。
pageWidth = doc.PageSetup.pageWidth - doc.PageSetup.LeftMargin - doc.PageSetup.RightMargin
' 遍历文档中的所有内嵌形状。
For Each obj In doc.InlineShapes
' 检查对象的宽度是否大于页面宽度。
tooLarge = obj.Width > pageWidth
' 如果对象太大，用书签标记它。
If tooLarge Then
objs.Add obj
End If
Next obj
For Each obj In doc.Tables
' 检查对象的宽度是否大于页面宽度。
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 tooLarge Then
objs.Add obj
End If
objWidth = 0: i = 0
Next obj
For Each obj In doc.Shapes
' 检查对象的宽度是否大于页面宽度。
tooLarge = obj.Width > pageWidth
' 如果对象太大，用书签标记它。
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
' 如果对象太大，用书签标记它。
rng.Bookmarks.Add "TOO_LARGE" & i, rng
Next obj
ur.EndCustomRecord
End Sub
多个PageSetup：
> ... 还有一个问题，如何确保在每个分节符（即，我在同一文档中有纵向/横向/纵向/横向页面方向）中都检查页面宽度... 我注意到横向方向的每个对象都被标记了。我尝试添加 "For Each Sec In doc.Section" 以重新计算页面宽度，但仍然使用纵向方向来检查整个文档...
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
' 获取页面宽度。
' pageWidth = doc.PageSetup.pageWidth - doc.PageSetup.LeftMargin - doc.PageSetup.RightMargin
pageWidth = sec.PageSetup.pageWidth - sec.PageSetup.LeftMargin - sec.PageSetup.RightMargin
' 遍历文档中的所有内嵌形状。
For Each obj In sec.Range.InlineShapes
' 检查对象的宽度是否大于页面宽度。
tooLarge = obj.Width > pageWidth
' 如果对象太大，用书签标记它。
If tooLarge Then
objs.Add obj
End If
Next obj
For Each obj In sec.Range.Tables
' 检查对象的宽度是否大于页面宽度。
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 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
' 检查对象的宽度是否大于页面宽度。
tooLarge = obj.Width > pageWidth
' 如果对象太大，用书签标记它。
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
' 如果对象太大，用书签标记它。
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
<details>
<summary>英文:</summary>
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:
```vba
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:
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论