WD97: Cannot Set More Than One Property on Merged Cell Using Range Object (239573)

WORKAROUND

Sub BuildTable()
  ' Create the table with merged cell
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:=4
  With ActiveDocument.Tables(1)
        .Cell(Row:=1, Column:=3).Merge _
        MergeTo:=.Cell(Row:=2, Column:=3)
       .Cell(Row:=2, Column:=1).Merge _
        MergeTo:=.Cell(Row:=4, Column:=2)
  End With
  shadecell
End Sub

Sub shadecell()
  Dim i As Integer
  Dim mycellrange As Range
  Dim startrange As Range
    For i = 1 To ActiveDocument.Tables(1).Range.Cells.Count
        Set mycellrange = ActiveDocument.Tables(1).Range.Cells(i).Range
        Set startrange = ActiveDocument.Range(Start:=mycellrange.Start, _
          End:=mycellrange.Start)
        With startrange.Cells.Shading
          .BackgroundPatternColorIndex = wdBrightGreen
        End With
        'MsgBox "cell = " & i
    Next i
    For i = 1 To ActiveDocument.Tables(1).Range.Cells.Count
        Set mycellrange = ActiveDocument.Tables(1).Range.Cells(i).Range
        Set startrange = ActiveDocument.Range(Start:=mycellrange.Start, _
          End:=mycellrange.Start)
        With startrange.Cells.Shading
          .Texture = wdTexture25Percent
        End With
    Next i
    For i = 1 To ActiveDocument.Tables(1).Range.Cells.Count
        Set mycellrange = ActiveDocument.Tables(1).Range.Cells(i).Range
        Set startrange = ActiveDocument.Range(Start:=mycellrange.Start, _
          End:=mycellrange.Start)
        With startrange.Cells.Shading
          .ForegroundPatternColorIndex = wdAuto
        End With
    Next i
End Sub