Всем привет!
Недавно я собирал большое количество документов в Word с сайта с помощью скрипта. К сожалению, некоторые картинки и таблицы вышли за границы документов. Я бы хотел проверить все документы на данный баг, а исправить уже вручную.
Пример файла с картинкой, которая выходит за границы выложил на файлообменник из-за большого веса:
https://transfiles.ru/08dwe
Вариант, который предложил GPT, но работает очень странно:

Код

Sub CheckShapesAndTablesOutOfMargins()    Dim folderPath As String    Dim fileSystem As Object    Dim folder As Object    Application.ScreenUpdating = False    ' Укажите путь к основной папке с подпапками    folderPath = "C:\Users\"    ' Создаем FileSystemObject для работы с файлами и папками    Set fileSystem = CreateObject("Scripting.FileSystemObject")    Set folder = fileSystem.GetFolder(folderPath)    ' Обходим все подпапки    Call CheckSubFolders(folder, fileSystem)    ' Очистка    Set fileSystem = Nothing    Set folder = Nothing    Application.ScreenUpdating = True    MsgBox "End" End Sub Sub CheckSubFolders(parentFolder As Object, fileSystem As Object)    Dim subFolder As Object    ' Проходим по всем подпапкам в текущей папке    For Each subFolder In parentFolder.Subfolders        ' Формируем путь к документу Word в текущей подпапке        Dim docPath As String        docPath = subFolder.Path & "\" & subFolder.Name & ".docx"        ' Проверяем, существует ли файл        If fileSystem.FileExists(docPath) Then            ' Вызываем функцию для проверки объектов, выходящих за поля            If CheckFileForOutOfMarginObjects(docPath) Then                Debug.Print "Найден объект, выходящий за границы полей в файле: " & docPath            End If        End If    Next subFolder End Sub Function CheckFileForOutOfMarginObjects(filePath As String) As Boolean    Dim doc As Document    Dim shape As InlineShape    Dim floatShape As Shape    Dim tbl As Table    Dim cell As Cell    Dim pageWidth As Single    Dim leftMargin As Single    Dim rightMargin As Single    Dim topMargin As Single    Dim bottomMargin As Single    Dim foundOutOfMargin As Boolean    Dim shapeLeft As Single    Dim shapeRight As Single    Dim shapeTop As Single    Dim shapeBottom As Single    Dim cellLeft As Single    Dim cellRight As Single    Dim cellTop As Single    Dim cellBottom As Single    ' Открываем документ    Set doc = Documents.Open(filePath, ReadOnly:=True)    foundOutOfMargin = False    ' Получаем ширину страницы и отступы    pageWidth = doc.PageSetup.PageWidth    leftMargin = doc.PageSetup.LeftMargin    rightMargin = doc.PageSetup.RightMargin    topMargin = doc.PageSetup.TopMargin    bottomMargin = doc.PageSetup.BottomMargin    ' Проверка каждой InlineShape    For Each shape In doc.InlineShapes        shapeLeft = shape.Range.Information(wdHorizontalPositionRelativeToPage)        shapeRight = shapeLeft + shape.Width        shapeTop = shape.Range.Information(wdVerticalPositionRelativeToPage)        shapeBottom = shapeTop + shape.Height        If shapeLeft < leftMargin Or shapeRight > pageWidth - rightMargin Or shapeTop < topMargin Or shapeBottom > pageWidth - bottomMargin Then            foundOutOfMargin = True            Exit For        End If    Next shape    ' Проверка каждой плавающей Shape    For Each floatShape In doc.Shapes        If floatShape.Type = msoPicture Then            shapeLeft = floatShape.Left + floatShape.Anchor.Paragraphs(1).Range.Information(wdHorizontalPositionRelativeToPage)            shapeRight = shapeLeft + floatShape.Width            shapeTop = floatShape.Top + floatShape.Anchor.Paragraphs(1).Range.Information(wdVerticalPositionRelativeToPage)            shapeBottom = shapeTop + floatShape.Height            If shapeLeft < leftMargin Or shapeRight > pageWidth - rightMargin Or shapeTop < topMargin Or shapeBottom > pageWidth - bottomMargin Then                foundOutOfMargin = True                Exit For            End If        End If    Next floatShape    ' Проверка каждой таблицы    For Each tbl In doc.Tables        For Each cell In tbl.Range.Cells            cellLeft = cell.Range.Information(wdHorizontalPositionRelativeToPage)            cellRight = cellLeft + cell.Width            cellTop = cell.Range.Information(wdVerticalPositionRelativeToPage)            cellBottom = cellTop + cell.Height            If cellLeft < leftMargin Or cellRight > pageWidth - rightMargin Or cellTop < topMargin Or cellBottom > pageWidth - bottomMargin Then                foundOutOfMargin = True                Exit For            End If        Next cell        If foundOutOfMargin Then Exit For    Next tbl    ' Закрываем документ без сохранения    doc.Close False    ' Возвращаем результат    CheckFileForOutOfMarginObjects = foundOutOfMargin End Function