Tables Rows and Hidden text

[frogman]

I have a macro that finds all the hidden text and deletes it but if the
text is in a table the rows stay. What I would like to find is if the
row is hidden then delete that row. I also have an instance where
there is hidden text in a table cell and I just want the text to be
deleted.

Code to delete all hidden text
Sub SendToClient()
Application.ScreenUpdating = False
Dim strNewName, strFileName, strLength, strFilePath As String
strFileName = ActiveDocument.Name
strFilePath = ActiveDocument.FullName
strLength = (Len(strFilePath))
strNewName = Left(strFilePath, strLength - 4)
ActiveWindow.View.ShowHiddenText = True
With Selection.Find
.ClearFormatting
.Font.Hidden = True
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.ActiveDocument.SaveAs (strNewName & "ClientCopy.DOC")
Application.ActiveWindow.ActivePane.View.ShowAll = False
Application.ScreenUpdating = True

End Sub


Code that needs help to find the hidden rows
'''Sub SendToClient()
'''Application.ScreenUpdating = False
'''Dim strFilePath, strFileName, strLength, strNewName As String
'''Dim intCountBold, intCount, i As Integer
'''strFileName = ActiveDocument.Name
'''strFilePath = ActiveDocument.FullName
'''strLength = (Len(strFilePath))
'''strNewName = Left(strFilePath, strLength - 4)
'''
'''Application.ActiveWindow.ActivePane.View.ShowAll = True
'''Selection.HomeKey unit:=wdStory
''' Selection.Find.ClearFormatting
''' With Selection.Find
''' .Text = ""
''' .Replacement.Text = ""
''' .Forward = True
''' .Wrap = wdFindContinue
''' .Format = True
''' .Font.Italic = True
''' .Font.Color = wdColorBlue
''' .Font.Hidden = True
''' .MatchCase = False
''' .MatchWholeWord = False
''' .MatchWildcards = False
''' .MatchSoundsLike = False
''' .MatchAllWordForms = False
''' End With
''' Selection.Find.Execute
'''
''''Loop through and find all tables and hide the tables
''' While Selection.Find.Found
''' Selection.Tables(1).Delete
''' Selection.HomeKey unit:=wdStory
''' Selection.Find.Execute
''' Wend
'''
''''Find all the hidden text
''' Selection.Find.ClearFormatting
''' With Selection.Find
''' .Text = ""
''' .Replacement.Text = ""
''' .Forward = True
''' .Wrap = wdFindContinue
''' .Format = True
''' .Font.Hidden = True
''' .MatchCase = False
''' .MatchWholeWord = False
''' .MatchWildcards = False
''' .MatchSoundsLike = False
''' .MatchAllWordForms = False
''' End With
''' Selection.Find.Execute
'''
''''Loop through and delete all the hidden text
''' While Selection.Find.Found
''' Selection.Delete
''' Selection.Find.Execute
''' Wend
'''Application.ActiveDocument.SaveAs (strNewName & "ClientCopy.DOC")
'''Application.ActiveWindow.ActivePane.View.ShowAll = False
'''Application.ScreenUpdating = True

'''End Sub

 

[Helmut Weber]

Hi,

like this, which should delete rows that contain only (!) hidden text
in the first table of the document's main story.
You might want to embed the code in a loop over all tables
in all storyranges in the doc.

With replacing hidden text inside and outside of tables
by nothing, there occurred no problems, here and now.

Note, that there is a kind of a logical twist in the function,
as it rather checks for non hidden text than the other way round.
Just another working solution.

And furthermore, if you replace hidden text with nothing
first, then you may end up with rows that contain no text,
which is neither hidden nor not hidden. ;-)

So delete rows with nothing but hidden text first.

Some things seem to be simple, but...

Dim oRow As Row
For Each oRow In ActiveDocument.Tables(1).Rows
If OnlyHiddenTextinRow(oRow) Then
oRow.Delete
End If
Next
End Sub

Public Function OnlyHiddenTextinRow(oRow As Row) As Boolean
OnlyHiddenTextinRow = True
Dim c As Cell
Dim r As Range
For Each c In oRow.Cells
Set r = c.Range
r.End = r.End - 2
If r.Font.Hidden <> True Then
OnlyHiddenTextinRow = False
Exit Function
End If
Next
End Function


Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[frogman]

thank you for the start I modified the code to get it to work for me.

Sub SendToClient()
Application.ScreenUpdating = False
Application.ActiveWindow.ActivePane.View.ShowAll = True
Dim strNewName, strFileName, strLength, strFilePath As String
Dim intTableCount, intTablesLeft, i As Integer

intTableCount = ActiveDocument.Tables.Count
strFileName = ActiveDocument.Name
strFilePath = ActiveDocument.FullName
strLength = (Len(strFilePath))
strNewName = Left(strFilePath, strLength - 4)


For i = 1 To intTableCount
Dim oRow As Row
For Each oRow In ActiveDocument.Tables(i).Rows
If OnlyHiddenTextinRow(oRow) = True Then
oRow.Delete
End If
Next

intTablesLeft = intTablesLeft + 1
If ActiveDocument.Tables.Count < intTableCount Then
intTableCount = ActiveDocument.Tables.Count
i = i - 1
intTablesLeft = intTablesLeft - 1
ElseIf ActiveDocument.Tables.Count = intTablesLeft Then
ActiveWindow.View.ShowHiddenText = True
With Selection.Find
.ClearFormatting
.Font.Hidden = True
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.ActiveDocument.SaveAs (strNewName & "ClientCopy.DOC")
Application.ActiveWindow.ActivePane.View.ShowAll = False
Application.ScreenUpdating = True
Exit Sub
End If
Next i

End Sub



Public Function OnlyHiddenTextinRow(oRow As Row) As Boolean
OnlyHiddenTextinRow = True
Dim oCell As Cell
Dim oRange, oRange2 As Range
For Each oCell In oRow.Cells
Set oRange = oCell.Range
Set oRange2 = oCell.Range
oRange.End = oRange.End
oRange2.End = oRange.End + 1

ActiveDocument.Range(oRange.End, oRange2.End).Select

If Selection.Font.Hidden <> True Then
OnlyHiddenTextinRow = False
Exit Function
End If
Next
End Function