wordobj.ActiveDocument.PrintOut
Sub Shade()
'
' Shade Macro
'
'
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Dim Row0SSH As String
Dim Row1SSH As String
Dim Row2SSH As String
Dim Row3SSH As String
Set exWb = objExcel.Workbooks.Open("C:\StdOpsV3\XLData.xlsx")
Dim PageCounter As Integer
PageCounter = 1
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
Dim cellcount As Integer
Dim doshade As Boolean
For Each oTbl In ActiveDocument.Tables
cellcount = 0
For Each oCel In oTbl.Range.Cells
doshade = False
cellcount = cellcount + 1
Set oRng = oCel.Range
oRng.End = oRng.End - 1
Select Case cellcount
Case 1
PageCounter = PageCounter + 1
Row0SSH = exWb.Sheets("Sheet1").Cells(PageCounter, 4)
Row1SSH = exWb.Sheets("Sheet1").Cells(PageCounter, 5)
Row2SSH = exWb.Sheets("Sheet1").Cells(PageCounter, 6)
Row3SSH = exWb.Sheets("Sheet1").Cells(PageCounter, 7)
Case 14, 15
If Row0SSH = "Yes" Then
doshade = True
oCel.Shading.BackgroundPatternColor = RGB(222, 129, 0)
End If
Case 21, 22
If Row1SSH = "Yes" Then
doshade = True
oCel.Shading.BackgroundPatternColor = RGB(222, 129, 0)
End If
Case 28, 29
If Row2SSH = "Yes" Then
doshade = True
oCel.Shading.BackgroundPatternColor = RGB(222, 129, 0)
End If
Case 35, 36
If Row3SSH = "Yes" Then
doshade = True
oCel.Shading.BackgroundPatternColor = RGB(222, 129, 0)
End If
End Select
If doshade Then
' this is every cell in Quality Section
Else
' These are cells other than Quality Cells
End If
Next
Next
End Sub
With maindoc.MailMerge
If OutputFormat = "PDF" Then
.Destination = wdSendToNewDocument
Else
.Destination = wdSendToPrinter
End If
.MainDocumentType = wdFormLetters
.SuppressBlankLines = True
' No need to OPEN the datasource as this is fixed and defined int he template.
With .DataSource
.FirstRecord = wdDefaultFirstRecord
If WhatToPrint = "All" Then
.LastRecord = wdDefaultLastRecord
Else
.LastRecord = 1
End If
End With
.Execute true 'False (pause)
End With
What do you mean by invoking it manually?