Coding error that is killing me

F

frogman

Sub SendToClient()
Application.ScreenUpdating = False
Application.ActiveDocument.Save
Application.ActiveWindow.ActivePane.View.ShowAll = True
Dim strNewName, strFileName, strLength, strFilePath, strLengthPath As
String
Dim intTableCount, intTablesLeft, i, j As Integer
Dim BMName As String
Dim BMCount As Integer
Dim CurrentBM As Bookmark
ReDim ary(ActiveDocument.Bookmarks.Count + 1) As Variant

intTableCount = ActiveDocument.Tables.Count
strFileName = ActiveDocument.Name
strFilePath = ActiveDocument.FullName
strLengthPath = (Len(strFilePath))
strLength = (Len(strFileName))

strNewName = Left(strFilePath, strLengthPath - 4)

'if a row in a table is hidden delete it
For i = 1 To intTableCount
Dim oRow As Row
For Each oRow In ActiveDocument.Tables(i).Rows ***'''this is where
it dies on the last table of the file'''***
If OnlyHiddenTextinRow(oRow) = True Then
oRow.Delete
End If
Next 'oRow
'keeping track of how many tables are left to search
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

'delete all the hidden text in the document
Selection.Find.Execute Replace:=wdReplaceAll

'save the new document with the ClientCopy tagged at the end
Application.ActiveDocument.SaveAs strNewName & "ClientCopy.doc",
wdFormatDocument
Application.ActiveWindow.ActivePane.View.ShowAll = False
Application.ScreenUpdating = True

'Get the number of bookmarks in the document
BMCount = ActiveDocument.Bookmarks.Count + 1

'Fill array with bookmark names
For j = 1 To BMCount
If j = ActiveDocument.Bookmarks.Count + 1 Then
ary(j) = ""
Else
Set CurrentBM = ActiveDocument.Bookmarks(j)
ary(j) = CurrentBM.Name
End If
Next j

'set j back to 1
j = 1

'delete the bookmark name until no more bookmark names exist
Do Until ary(j) = ""
BMName = ary(j)
ActiveDocument.Bookmarks(BMName).Delete
j = j + 1
Loop

Application.ActiveWindow.View.ShowHiddenText = False

'delete the toolbar
Application.CommandBars("Spec Tools").Delete

'deletes all code
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Set VBComps = ActiveDocument.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm,
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
Application.ActiveDocument.Save
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
 
F

frogman

Where is the error?
the error is marked ***''' '''***


What error message do you see?
the error box is blank


What are you trying to achieve? this code goes through the doc and
deletes all the hidden text and bookmarks and code and renames the file
so we can send it to a client with out all of our code in it.


What is happening instead?
it has to do with how i am tracking the tables
 
J

Jean-Guy Marcil

frogman was telling us:
frogman nous racontait que :
Where is the error?
the error is marked ***''' '''***


What error message do you see?
the error box is blank


What are you trying to achieve? this code goes through the doc and
deletes all the hidden text and bookmarks and code and renames the
file so we can send it to a client with out all of our code in it.


What is happening instead?
it has to do with how i am tracking the tables

Does this last table have merged cells? If so, your code will not work.

There are problems with your table manipulation approach. If a table is
entirely comprised of cells with hidden text, you will remove the whole
table and therefore throw the counter out of sync and will get an error.

Also, you should review your code and remove all Selection objects and
replace then with Range object. This will make the code run faster and be
more reliable.
As an example, see my version of your "OnlyHiddenTextinRow" function:

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

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org
 
F

frogman

thank you
you helped me get there and i love the faster code

Sub SendToClient()
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Application.ActiveDocument.Save
Application.ActiveWindow.ActivePane.View.ShowAll = True
Dim strNewName, strFileName, strLength, strFilePath, strLengthPath As
String
Dim intTableCount As Integer
Dim intTableIndex As Integer
Dim intTablesLeft As Integer
Dim intTableNotDeletedCount As Integer
Dim i As Integer
Dim j As Integer
Dim BMName As String
Dim BMCount As Integer
Dim CurrentBM As Bookmark
ReDim ary(ActiveDocument.Bookmarks.Count + 1) As Variant

intTableCount = ActiveDocument.Tables.Count
intTablesLeft = ActiveDocument.Tables.Count
strFileName = ActiveDocument.Name
strFilePath = ActiveDocument.FullName
strLengthPath = (Len(strFilePath))
strLength = (Len(strFileName))

strNewName = Left(strFilePath, strLengthPath - 4)

'if a row in a table is hidden delete it
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 'oRow

'if the is not deleted count it and make i increment to keep the
table collection pure
If intTableCount = ActiveDocument.Tables.Count Then
i = i + 1
intTableNotDeletedCount = intTableNotDeletedCount + 1
End If

'if the current count of the tables minus the tables not deleted is
greater than 0 then there are more tables to process
If ActiveDocument.Tables.Count - intTableNotDeletedCount > 0 Then
intTableCount = ActiveDocument.Tables.Count
i = i - 1

'if no more tables to process then clean the rest of the document
up.
ElseIf ActiveDocument.Tables.Count = intTableNotDeletedCount 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

'delete all the hidden text in the document
Selection.Find.Execute Replace:=wdReplaceAll

'save the new document with the ClientCopy tagged at the end
Application.ActiveDocument.SaveAs strNewName & "ClientCopy.doc",
wdFormatDocument
Application.ActiveWindow.ActivePane.View.ShowAll = False
Application.ScreenUpdating = True

'Get the number of bookmarks in the document
BMCount = ActiveDocument.Bookmarks.Count + 1

'Fill array with bookmark names
For j = 1 To BMCount
If j = ActiveDocument.Bookmarks.Count + 1 Then
ary(j) = ""
Else
Set CurrentBM = ActiveDocument.Bookmarks(j)
ary(j) = CurrentBM.Name
End If
Next j

'set j back to 1
j = 1

'delete the bookmark name until no more bookmark names exist
Do Until ary(j) = ""
BMName = ary(j)
ActiveDocument.Bookmarks(BMName).Delete
j = j + 1
Loop

Application.ActiveWindow.View.ShowHiddenText = False
Application.ScreenUpdating = True

'delete the toolbar
Application.CommandBars("Spec Tools").Delete

'deletes all code
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Set VBComps = ActiveDocument.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm,
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
Application.ActiveDocument.Save
Exit Sub
End If
Next i

End Sub
'only delete the hidden rows
Public Function OnlyHiddenTextinRow(oRow As Row) As Boolean
OnlyHiddenTextinRow = True
Dim oCell As Cell
For Each oCell In oRow.Cells
If oCell.Range.Font.Hidden <> True Then
OnlyHiddenTextinRow = False
Exit Function
End If
Next
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top