-
As an example, here is some code which would do what you want... but without adding blank rows.
The benefit to this structure, is that without adding rows... you have the ability to change the data in your table, and "re-run" the same routine without needing to test whether an existing row is
a) already a header row
b) a blank first cell, but data in other cells of that row
c ) a "true" blank row, which is only there because of a desire for a certain look (i.e., if you insert 2 rows above an existing header row, then you can't run the routine more than once without testing to see if you've already inserted those two rows, or if you've later filled in data in one of those two blank cells, and thus only need to insert 1 blank row... or if you've inserted data into both blank rows).
In short-- try to avoid using blank rows specifically for formatting purposes in the same way that you try to avoid using blank paragraphs to achieve space between paragraphs with text in them... use space before or space after properties on a "real" paragraph. Otherwise you have to use a bunch of extra code to see if a row (or paragraph) is a "real" row (or paragraph) or simply a "fake" row (or paragraph) which only exists for formatting purposes.
Make sense?
[vba]
'-----------------------------------------------------------------------------------------------
' A tool for clearing out duplicate entries
'-----------------------------------------------------------------------------------------------
Public Sub DeleteDuplicateRowsEasier()
Dim oTable As Table
Dim sText As String
Dim i As Integer
Dim iRowCount As Integer
Dim sCellText As String
On Error GoTo ErrorHandler
Set oTable = ActiveDocument.Tables(1)
With oTable
'initialize our check before we enter our loop
sText = .Rows(1).Cells(1).Range.text
'start at our 2nd row
For i = 2 To .Rows.Count
'if it's equal to our flag, delete it
If .Rows(i).Cells(1).Range.text = sText Then
.Rows(i).Cells(1).Range.text = ""
'otherwise, reset our flag
Else
sText = .Rows(i).Cells(1).Range.text
End If
Next
'now format the rows
For i = 1 To .Rows.Count
'if it has anything but the end of cell markers, then it's a "header" row
sCellText = .Rows(i).Cells(1).Range.text
sCellText = Replace(sCellText, Chr(13) & Chr(7), "")
If sCellText = "" Then
FormatNormalRow .Rows(i)
Else
FormatHeaderRow .Rows(i)
End If
Next
End With
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
'-----------------------------------------------------------------------------------------------
'format "header" rows
'-----------------------------------------------------------------------------------------------
Public Sub FormatHeaderRow(oRow As Row)
'first clear the borders
ClearBorders oRow
'then apply a border
With oRow
'add a border to the top
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth300pt
.Color = wdColorAutomatic
End With
'and add some space to the previous row, if it exists
If Not oRow.Previous Is Nothing Then
oRow.Previous.Height = 30
End If
End With
End Sub
'-----------------------------------------------------------------------------------------------
'Format "normal" rows
'-----------------------------------------------------------------------------------------------
Public Sub FormatNormalRow(oRow As Row)
'clear the borders of the row
ClearBorders oRow
End Sub
'-----------------------------------------------------------------------------------------------
'pass in a row object, clear all the borders off it
'-----------------------------------------------------------------------------------------------
Public Sub ClearBorders(oRow As Row)
With oRow
'this clears out any existing borders
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
End Sub
[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules