Selecting in Word from Excel

scienceguy · #1 10-17-2019, 01:22 PM

Hello,

I'm writing an app that modifies each header from a folder of Word files, using an Excel VBA. The goals are:

Delete the existing header
Add a new table to the header
Populate the new table with information from Excel
Add "Page x of y" to one of the cells
Format the table

When I get to the Select code, an error is thrown. I'm guessing the document is not active in the proper way? The first error is thrown when I try to add "Page x of y" to cell(2,2). The next error is thrown when I try to right justify the second column.

I've provided some code below to illustrate the problem.

Any guidance would be appreciated.

Thank you,
Roy

Code:

Sub modifyHeader()

Dim wdApp As Object
Dim wdDoc As Object
Dim strFolder As String

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        strFolder = .SelectedItems(1)
    End If
End With
If strFolder = "" Then
    Exit Sub
End If

Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False

strfile = Dir(strFolder & "\*.doc", vbNormal)

While strfile <> ""
    Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strfile, AddToRecentFiles:=False, Visible:=False)
   
   
    'delete existing header
    wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
    
    'add a table to header
    wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables.Add _
      Range:=wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
      NumRows:=2, _
      NumColumns:=2
      
      With wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1)
          .Range.Font.Bold = True
          .Range.Font.Name = "Times New Roman"
          .Range.Font.Size = 10
          .Cell(1, 1).Range.Text = "ABC-000"
          .Cell(2, 1).Range.Text = "Manufacturer"
          
          .Cell(2, 2).Select
          With Selection
              .TypeText Text:="Page "
              .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  \* Arabic ", PreserveFormatting:=True
              .TypeText Text:=" of "
              .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="NUMPAGES  ", PreserveFormatting:=True
          End With
          
          .Columns(2).Select
          With Selection
              .ParagraphFormat.Alignment = wdAlignParagraphRight
          End With
      
      End With


    
'Needed?
'    ActiveDocument.ActiveWindow.View.Type = wdPrintView
'    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'    ActiveDocument.ActiveWindow.View.Type = wdPrintView

    
    Application.DisplayAlerts = False
    wdDoc.Close True
    Application.DisplayAlerts = True
    
    strfile = Dir()
Wend

Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing


MsgBox "Finished!"

End Sub

gmayor · #2 10-17-2019, 08:36 PM

Not tested, but the following should work. You don't 'select' the cells if you work with ranges, and you can't use Word specific commands when late binding to Word in Excel - you must use their numeric equivalents, thus

Code:

Sub modifyHeader()

Dim wdApp As Object
Dim wdDoc As Object
Dim oTable As Object
Dim oCell As Object
Dim oRng As Object

Dim strFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            strFolder = .SelectedItems(1)
        End If
    End With
    If strFolder = "" Then
        Exit Sub
    End If

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False

    strFile = Dir(strFolder & "\*.doc", vbNormal)

    While strFile <> ""
        Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)


        'delete existing header
        Set oRng = wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
        oRng.Text = ""

        'add a table to header
        Set oTable = wdDoc.Tables.Add _
                (Range:=oRng, _
                NumRows:=2, _
                NumColumns:=2)

        With oTable
        .Range.Font.Bold = True
        .Range.Font.Name = "Times New Roman"
        .Range.Font.Size = 10
        Set oCell = .Cell(1, 1).Range
        oCell.End = oCell.End - 1
        oCell.Text = "ABC-000"

        Set oCell = .Cell(2, 1).Range
        oCell.End = oCell.End - 1
        oCell.Text = "Manufacturer"

        Set oCell = .Cell(2, 2).Range
        oCell.ParagraphFormat.Alignment = 2
        oCell.End = oCell.End - 1
        oCell.Text = "Page "
        oCell.Collapse 0
        wdDoc.Fields.Add Range:=oCell, Type:=33, Text:=" \* Arabic ", PreserveFormatting:=False
        Set oCell = .Cell(2, 2).Range
        oCell.End = oCell.End - 1
        oCell.Collapse 0
        oCell.Text = " of "
        oCell.Collapse 0
        wdDoc.Fields.Add Range:=oCell, Type:=26, PreserveFormatting:=False
    End With



        'Needed? - NO!
        '    ActiveDocument.ActiveWindow.View.Type = wdPrintView
        '    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        '    ActiveDocument.ActiveWindow.View.Type = wdPrintView


        Application.DisplayAlerts = False
        wdDoc.Close True
        Application.DisplayAlerts = True

        strFile = Dir()
    Wend

    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing


    MsgBox "Finished!"

End Sub

scienceguy · #3 10-18-2019, 04:45 AM

Many thanks, Graham! This worked great! I really appreciate your time and coaching!

Sincerely,
Roy

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Programmatically Selecting Files in Word for Windows	Ajay2506	Word VBA	2	06-24-2016 10:23 AM
Selecting certain text in word	nancy	Word VBA	4	04-06-2016 04:33 PM
Selecting the same word multiple times at one go	No.1	Word	3	08-08-2013 06:29 PM
selecting ms word bookmarks using vba	dnc	Word VBA	4	05-10-2013 04:58 PM
VBA equivalent to selecting present word	KevinJ	Word VBA	2	11-05-2012 01:27 PM