добавление текста, таблицы и номера страницы в нижний колонтитул в Excel VBA - PullRequest
0 голосов
/ 04 января 2019

Я пытался создать макрос для верхнего и нижнего колонтитула.Нет проблем с заголовком, я могу его создать.Проблема заключается в нижнем колонтитуле, где я должен создать таблицу 2x1 (размерность согласно коду) вместе с 2 строками текста и номером страницы (в формате страница 1 из xx).

Язастрял, потому что, когда я запускаю код, всплывает либо таблица, либо текст.Как я могу изменить код, чтобы я мог иметь и таблицу, и текст, и номер страницы.

Спасибо!

Sub CreateWord()

Dim objWord As Object
Dim objdoc As Object
Dim objrange As Word.Range
Dim myTable As Table
Dim i As Long

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objdoc = objWord.Documents.Add()
objdoc.PageSetup.OddAndEvenPagesHeaderFooter = False


For i = 1 To objdoc.Sections.Count
   With objdoc.Sections(i)

       Set objrange = .Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
       objrange = "PRIVATE AND CONFIDENTIAL"
       objrange.Font.Name = "Arial"
       objrange.Font.Size = 11
       objrange.Font.Bold = wdToggle
       objrange.ParagraphFormat.Alignment = wdAlignParagraphCenter
       Set objrange = Nothing

       Set objrange = .Footers(wdHeaderFooterPrimary).Range
       objrange = "text1" & vbNewLine & "text2" & vbNewLine & " " & vbNewLine & " "
       .Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True
       objrange.Font.Name = "Arial"
       objrange.Font.Size = 9
       objrange.Font.Bold = wdToggle
       objrange.ParagraphFormat.Alignment = wdAlignParagraphLeft
       Set objrange = Nothing

       .Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True

   End With

     With objdoc
         Set myTable = .Tables.Add(.Sections(1).Footers(wdHeaderFooterPrimary).Range, 2, 1)
     End With

         With myTable

             .Cell(1, 1).Range.Text = "Employee"
             .Cell(2, 1).Range.Text = " " & vbNewLine & " "
             .Rows.SetLeftIndent LeftIndent:=395, RulerStyle:=wdAdjustFirstColumn
             .Borders.InsideLineStyle = wdLineStyleSingle
             .Borders.OutsideLineStyle = wdLineStyleSingle
         End With
Next

End Sub

1 Ответ

0 голосов
/ 04 января 2019

Word сложнее, чем Excel.Вы застряли в предположении, что Footer.Range будет идентичен как с его текстом, так и с его абзацами.Фактически, нижний колонтитул включает несколько абзацев с отдельными диапазонами, и каждый из них имеет свой собственный текст, который действительно является свойством по умолчанию, но не идентичен, так же как значение ячейки не идентично ячейке в Excel.Я проверил код ниже в Word.Я думаю, что он будет работать в Excel после переопределения объекта objWord.Удачи!

Sub CreateWord()
    ' 04 Jan 2019

    Dim objWord As Object
    Dim objDoc As Object
    Dim objRange As Word.Range
    Dim myTable As Table
    Dim i As Long
    Dim f As Long

'    Set objWord = CreateObject("Word.Application")
    Set objWord = Application
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add()
    objDoc.PageSetup.OddAndEvenPagesHeaderFooter = False

    For i = 1 To objDoc.Sections.Count
        With objDoc.Sections(i)
            Set objRange = .Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
            objRange = "PRIVATE AND CONFIDENTIAL"
            objRange.Font.Name = "Arial"
            objRange.Font.Size = 11
            objRange.Font.Bold = vbTrue              'wdToggle
            objRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
            Set objRange = Nothing

            ' you are setting only one header
            ' the code below sets all footers
            For f = wdHeaderFooterPrimary To wdHeaderFooterFirstPage
                Set objRange = .Footers(f).Range
                With objRange
                    .ParagraphFormat.Alignment = wdAlignParagraphLeft
                    With .Font
                        .Name = "Arial"
                        .Size = 9
                        .Bold = vbTrue                  'wdToggle
                    End With
                    .Text = "text1" & Chr(11) & _
                            "text2" & Chr(9) & "Page "
                    .Collapse wdCollapseEnd
                    .Fields.Add Range:=objRange, _
                                Type:=wdFieldEmpty, _
                                Text:="PAGE  \* Arabic ", _
                                PreserveFormatting:=True
                End With

                Set objRange = .Footers(f).Range.Paragraphs(1).Range
                With objRange
                    .Paragraphs.Add
                    .Collapse wdCollapseEnd
                    Set myTable = .Tables.Add(objRange, 2, 1)
                End With

                ' vbNewLine = Chr(13) = hard return = new paragraph
                ' Chr(11) = soft return = new line
                With myTable
                    .Cell(1, 1).Range.Text = "Employee"
                    .Cell(2, 1).Range.Text = " " & Chr(11) & " "
                    ' you may want to set the left margin of the paragraph
                    ' rather than indenting the table:-
                    .Rows.SetLeftIndent LeftIndent:=39.5, RulerStyle:=wdAdjustFirstColumn
                    .Borders.InsideLineStyle = wdLineStyleSingle
                    .Borders.OutsideLineStyle = wdLineStyleSingle
                End With
            Next f
        End With
    Next i
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...