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
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