Установите ориентацию страницы при экспорте таблицы Excel в Word

Question

Я боролся с приложенным кодом VBA, который пытается установить ориентацию страницы при экспорте таблицы Excel в Word.Это достаточно просто сделать для одной таблицы, но я пытаюсь экспортировать несколько таблиц, некоторые из которых должны быть портретными, а другие - альбомными.Проблема перехода с одного формата на другой в новом документе Word.Я пробовал различные способы добавления разрывов разделов, но мне не удалось сделать что-то близкое к тому, что я хочу.

Фрагмент ниже запускается в цикле, который экспортирует каждую таблицу, так как элементы управления формы проверяются на выбор..

Код зависит от выбора пользователя в форме, поэтому они могут отличаться каждый раз.Чтобы было легче читать, я включил только те разделы кода, которые фактически имеют дело с форматированием нового документа Word (newDoc).То, что показано, является последним воплощением кода, было много версий.

Мне нужен способ запуска цикла (и прикрепленного кода), чтобы каждая таблица была ориентирована в соответствии с заранее определенными потребностями.или портрет, или пейзаж в новом документе Word.

Select Case intDoc  ' set the Word pages based on the selected document
                Case 1, 4, 5, 6 ' Estimate(1), Invoice(4), Scope of Work-->Orientation = wdOrientPortrait
                    ' paste the table into the newDoc and set some options
                    With newDoc
                        .ActiveWindow.View.ShowAll = False ' Hide all formatting marks
                        .ActiveWindow.View.ShowHiddenText = False ' Hide all  hidden text
                        .Paragraphs(.Paragraphs.Count).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=True
                        .Content.InsertParagraphAfter
                        .Range(.Content.End - 1).InsertBreak Type:=wdSectionBreakNextPage   'wdPageBreak
                        With .PageSetup
                            .Orientation = wdOrientPortrait
                            .RightMargin = Application.InchesToPoints(0.75)
                            .LeftMargin = Application.InchesToPoints(0.75)
                        End With
                     End With
                    ' Autofit the table to the page
                     Set wordTbl = newDoc.Tables(newDoc.Tables.Count)
                     wordTbl.AutoFitBehavior (wdAutoFitWindow)</p>

            Case 2, 3  ' the Detail listing (2), or the Itemized listing(3)-->Orientation = wdOrientLandscape
                ' paste the table into the newDoc and set some options
                With newDoc
                    .ActiveWindow.View.ShowAll = False ' Hide all formatting marks
                    .ActiveWindow.View.ShowHiddenText = False ' Hide all  hidden text
                    .Paragraphs(.Paragraphs.Count).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=True
                    .Content.InsertParagraphAfter
                    .Range(.Content.End - 1).InsertBreak Type:=wdSectionBreakNextPage   'wdPageBreak
                    With .PageSetup
                        .Orientation = wdOrientLandscape
                        .RightMargin = Application.InchesToPoints(0.5)
                        .LeftMargin = Application.InchesToPoints(0.5)
                    End With
                 End With
                ' Autofit the table to the page
                 Set wordTbl = newDoc.Tables(newDoc.Tables.Count)
                 wordTbl.AutoFitBehavior (wdAutoFitWindow)
        End Select

Answer 1

Поскольку вы не предоставили [mcve], я не могу напрямую работать с вашим кодом.Ниже приведен мой тестовый код - вы должны быть в состоянии адаптировать его к вашему конкретному сценарию.Было бы несколько способов подойти к задаче, но я старался максимально приблизиться к вашему исходному подходу.

Обратите внимание, что я добавил переменную объекта rngNewTable - a Word.Range объект.Это помогает лучше отслеживать, где именно что-то должно происходить в документе (на самом деле так же, как в Excel).Document.Content предоставляет хороший справочный диапазон, но он не «адаптируется» для идентификации конкретной точки или области.

Я также добавил переменную для хранения текущей ориентации страницы.Нет необходимости повторять определенные действия, если ориентация уже правильная, поэтому это используется для проверки текущей ориентации.(На самом деле, вам даже не понадобятся отдельные разделы для каждой таблицы, если ориентация не изменится - но я не знаю полной логики происходящего, поэтому не изменил это.)

Вставка таблицы теперь выполняется в конце каждого цикла и может выходить за пределы Select, но я оставляю это решение вам.Вам также необходимо заменить мою For...Next своей собственной логикой.

Способ, которым это в основном работает, состоит в том, чтобы свернуть / установить конец цели Range после каждой вставки (будь то таблица или разрыв раздела), так что это всегда после нового материала.

Sub InsertTableWithPageOrientation()
    Dim newDoc As Word.Document
    Dim intDoc(3) As Long, iCounter As Long
    Dim rngNewTable As Word.Range
    Dim iCurrPageOrientation As Long
    Dim wordTbl

    Set newDoc = ActiveDocument
    With newDoc
        .ActiveWindow.View.ShowAll = False ' Hide all formatting marks
        .ActiveWindow.View.ShowHiddenText = False ' Hide all  hidden text
        Set rngNewTable = newDoc.content
        rngNewTable.Collapse wdCollapseEnd
        iCurrPageOrientation = .PageSetup.Orientation
    End With
    intDoc(0) = 1
    intDoc(1) = 2
    intDoc(2) = 3
    intDoc(3) = 4
    For iCounter = LBound(intDoc) To UBound(intDoc)
        rngNewTable.InsertBreak Type:=wdSectionBreakNextPage   'wdPageBreak
        rngNewTable.Start = newDoc.content.End
        Select Case intDoc(iCounter)  ' set the Word pages based on the selected document
            Case 1, 4, 5, 6 ' Estimate(1), Invoice(4), Scope of Work-->Orientation = wdOrientPortrait
                ' paste the table into the newDoc and set some options
                If iCurrPageOrientation <> wdOrientPortrait Then
                    With rngNewTable.Sections(1).PageSetup
                        .Orientation = wdOrientPortrait
                        .RightMargin = Application.InchesToPoints(0.75)
                        .LeftMargin = Application.InchesToPoints(0.75)
                        iCurrPageOrientation = wdOrientPortrait
                    End With
                End If
                rngNewTable.PasteExcelTable LinkedToExcel:=false, WordFormatting:=False, RTF:=True
                rngNewTable.Start = newDoc.content.End
            Case 2, 3  ' the Detail listing (2), or the Itemized listing(3)-->Orientation = wdOrientLandscape
                ' paste the table into the newDoc and set some options
                If iCurrPageOrientation <> wdOrientLandscape Then
                    With rngNewTable.Sections(1).PageSetup
                        .Orientation = wdOrientLandscape
                        .RightMargin = Application.InchesToPoints(0.5)
                        .LeftMargin = Application.InchesToPoints(0.5)
                        iCurrPageOrientation = wdOrientLandscape
                    End With
                End If
                rngNewTable.PasteExcelTable LinkedToExcel:=false, WordFormatting:=False, RTF:=True
                rngNewTable.Start = newDoc.content.End
        End Select
    Next
    ' Autofit the table to the page
    Set wordTbl = newDoc.Tables(newDoc.Tables.Count)
    wordTbl.AutoFitBehavior (wdAutoFitWindow)
End Sub