Microsoft Office Forums Selecting in Word from Excel

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-17-2019, 01:22 PM
scienceguy scienceguy is offline Selecting in Word from Excel Windows 10 Selecting in Word from Excel Office 2016
Novice
Selecting in Word from Excel
 
Join Date: Feb 2019
Posts: 23
scienceguy is on a distinguished road
Default Selecting in Word from Excel

Hello,

I'm writing an app that modifies each header from a folder of Word files, using an Excel VBA. The goals are:
  1. Delete the existing header
  2. Add a new table to the header
  3. Populate the new table with information from Excel
  4. Add "Page x of y" to one of the cells
  5. 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
Reply With Quote
  #2  
Old 10-17-2019, 08:36 PM
gmayor's Avatar
gmayor gmayor is offline Selecting in Word from Excel Windows 10 Selecting in Word from Excel Office 2016
Expert
 
Join Date: Aug 2014
Posts: 3,000
gmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nice
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 10-18-2019, 04:45 AM
scienceguy scienceguy is offline Selecting in Word from Excel Windows 10 Selecting in Word from Excel Office 2016
Novice
Selecting in Word from Excel
 
Join Date: Feb 2019
Posts: 23
scienceguy is on a distinguished road
Default

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

Sincerely,
Roy
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Selecting in Word from Excel 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 in Word from Excel Selecting the same word multiple times at one go No.1 Word 3 08-08-2013 06:29 PM
Selecting in Word from Excel selecting ms word bookmarks using vba dnc Word VBA 4 05-10-2013 04:58 PM
Selecting in Word from Excel VBA equivalent to selecting present word KevinJ Word VBA 2 11-05-2012 01:27 PM


All times are GMT -7. The time now is 11:26 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft