Looping in a table

Dear All

I am trying to recurse through every cell in the the first
column of a table and obtain the cell contents. I have
used the following code (which works) but could be better:

Dim oRow As Row
Dim oCell As Cell
Dim sCellText As String
For Each oRow In ActiveDocument.Tables(1).Rows
sCellText = oRow.Cells(1).Range
sCellText = Left$(sCellText, Len(sCellText) - 2)
Debug.Print Trim(sCellText)
Next oRow

but I do not want all values returned but only those where
the cell or the font is NOT shaded or conversely where the
cell has no shading at all in the font or cell itself. It
is this part I am stuck with.

Can someone please help me?

Alastair MacFarlane
(very bad at Word VBA)

Greg
Mon Mar 14 10:16:00 CST 2005

Alastair,

See if something like this helps:

Sub Test()
Dim oRow As Row
Dim oCell As Cell
Dim sCellText As String
For Each oRow In ActiveDocument.Tables(1).Rows
If oRow.Cells(1).Shading.BackgroundPatternColorIndex = wdAuto Then
sCellText = oRow.Cells(1).Range
sCellText = Left$(sCellText, Len(sCellText) - 2)
Debug.Print Trim(sCellText)
End If
Next
End Sub

Alastair
Mon Mar 14 10:51:19 CST 2005

Thanks Greg for the quick response. I was obviously
looking deeper than that because I thought I would need to
check both the background colour and the font shaded
colour.

Sometimes it is the straightforward answer that is correct.

Alastair
>-----Original Message-----
>Alastair,
>
>See if something like this helps:
>
>Sub Test()
>Dim oRow As Row
>Dim oCell As Cell
>Dim sCellText As String
>For Each oRow In ActiveDocument.Tables(1).Rows
> If oRow.Cells(1).Shading.BackgroundPatternColorIndex =
wdAuto Then
> sCellText = oRow.Cells(1).Range
> sCellText = Left$(sCellText, Len(sCellText) - 2)
> Debug.Print Trim(sCellText)
> End If
>Next
>End Sub
>
>.
>

Helmut
Mon Mar 14 11:41:02 CST 2005

Hi Alastair,

in case you'd like to look deeper:

Sub CellOrTextOrNoneOfThemShaded()
Dim oCll As Cell ' object Cell
Dim sCll As String ' string Cell
ActiveDocument.Tables(1).Columns(1).Select
' selection might be more often, not to say always,
' faster than ranges in tables
For Each oCll In Selection.Cells

If TextHasShading(oCll.Range) And CellHasShading(oCll.Range) Then
MsgBox Left$(sCll, Len(sCll) - 2)
End If
If TextHasShading(oCll.Range) Or CellHasShading(oCll.Range) Then
sCll = oCll.Range.Text
MsgBox Left$(sCll, Len(sCll) - 2)
End If
Next
End Sub
' ---
Public Function TextHasShading(oRng As Range) As Boolean
Dim lBckTxt As Long ' BackgroundPatternColor of text
Dim lFrgTxt As Long ' ForeroundPatternColor of text
Dim lTxtTxt As Long ' Texture of text

With oRng
lBckTxt = .Font.Shading.BackgroundPatternColor
lFrgTxt = .Font.Shading.ForegroundPatternColor
lTxtTxt = .Font.Shading.Texture
End With
If lBckTxt < 0 And lFrgTxt < 0 And lTxtTxt = 0 Then
TextHasShading = False
Else
TextHasShading = True
End If
End Function
' ---
Public Function CellHasShading(oRng As Range) As Boolean
Dim lBckCll As Long ' BackgroundPatternColor of Cell
Dim lFrgCll As Long ' ForeroundPatternColor of Cell
Dim lTxtCll As Long ' Texture of Cell

With oRng
lBckCll = .Shading.BackgroundPatternColor
lFrgCll = .Shading.ForegroundPatternColor
lTxtCll = .Shading.Texture
End With
If lBckCll < 0 And lFrgCll < 0 And lTxtCll = 0 Then
CellHasShading = False
Else
CellHasShading = True
End If
End Function

At least I enjoyed it.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

Alastair
Mon Mar 14 15:12:00 CST 2005

Helmut,

Thanks for your input. It may take me quite a while to go through your code
and I am glad that I asked a question that got you-a-thinking. I don't think
it will be long before I ask another question.

Thanks...

Alastair

"Helmut Weber" <elmkqznfwvccbf@mailinator.com> wrote in message
news:ftib31ts6fqgfajudubq3fhgrt05j3tlo2@4ax.com...
> Hi Alastair,
>
> in case you'd like to look deeper:
>
> Sub CellOrTextOrNoneOfThemShaded()
> Dim oCll As Cell ' object Cell
> Dim sCll As String ' string Cell
> ActiveDocument.Tables(1).Columns(1).Select
> ' selection might be more often, not to say always,
> ' faster than ranges in tables
> For Each oCll In Selection.Cells
>
> If TextHasShading(oCll.Range) And CellHasShading(oCll.Range) Then
> MsgBox Left$(sCll, Len(sCll) - 2)
> End If
> If TextHasShading(oCll.Range) Or CellHasShading(oCll.Range) Then
> sCll = oCll.Range.Text
> MsgBox Left$(sCll, Len(sCll) - 2)
> End If
> Next
> End Sub
> ' ---
> Public Function TextHasShading(oRng As Range) As Boolean
> Dim lBckTxt As Long ' BackgroundPatternColor of text
> Dim lFrgTxt As Long ' ForeroundPatternColor of text
> Dim lTxtTxt As Long ' Texture of text
>
> With oRng
> lBckTxt = .Font.Shading.BackgroundPatternColor
> lFrgTxt = .Font.Shading.ForegroundPatternColor
> lTxtTxt = .Font.Shading.Texture
> End With
> If lBckTxt < 0 And lFrgTxt < 0 And lTxtTxt = 0 Then
> TextHasShading = False
> Else
> TextHasShading = True
> End If
> End Function
> ' ---
> Public Function CellHasShading(oRng As Range) As Boolean
> Dim lBckCll As Long ' BackgroundPatternColor of Cell
> Dim lFrgCll As Long ' ForeroundPatternColor of Cell
> Dim lTxtCll As Long ' Texture of Cell
>
> With oRng
> lBckCll = .Shading.BackgroundPatternColor
> lFrgCll = .Shading.ForegroundPatternColor
> lTxtCll = .Shading.Texture
> End With
> If lBckCll < 0 And lFrgCll < 0 And lTxtCll = 0 Then
> CellHasShading = False
> Else
> CellHasShading = True
> End If
> End Function
>
> At least I enjoyed it.
>
> Greetings from Bavaria, Germany
>
> Helmut Weber, MVP
> "red.sys" & chr(64) & "t-online.de"
> Word XP, Win 98
> http://word.mvps.org/
>
>