D
David Schenkler
I am trying to run a Macro on Tables that will first Split the tables by a certain criteria, then color specific areas.
The colors one nearly works, but more important is that the splitting of the table does not work. With a different macro it worked, but it did not carry the Header Row to all tables. If you see code here you do not recognize it is because I have another Reference Library added.
This is my macro:
Private Sub processParentTable()
Dim strTemp As String
Dim newString As String
Dim lineString As String
Dim startPos As Long
Dim endPos As Long
Dim myRange As Range
newString = ""
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="$$Interface Type", Forward:=True
If myRange.Find.found Then
myRange.Text = "Interface Type"
myRange.Expand Unit:=wdTable
myRange.Select
Dim noOfRows As Long
noOfRows = myRange.Rows.count
Dim i As Long
For i = 2 To noOfRows
Dim rowRange As Range
processSplitTables (myRange.Rows(i))
Next i
End If
End Sub
Private Sub processSplitTables(r As Range)
Dim Tbl As Table
Dim interfaceTypeCell As String
For Each Tbl In ActiveDocument.Tables
Set r = Tbl.Range
interfaceTypeCell = r.Cells(3).Range.Text
If interfaceTypeCell = "Interface Definition" Then
Dim interfaceType As Long
interfaceType = r.Text
If interfaceType = "Interface Definition" Then
Dim q As Long
For q = 1 To interfaceType
r.Expand Unit:=wdRow
r.Select
If r.Cells(1).RowIndex > 1 Then
r.Tables(1).Split r.Cells(1).RowIndex
End If
Next q
r.Shading.BackgroundPatternColor = wdColorLightYellow
End If
End If
Next
End Sub
Thank you very much!!!
The colors one nearly works, but more important is that the splitting of the table does not work. With a different macro it worked, but it did not carry the Header Row to all tables. If you see code here you do not recognize it is because I have another Reference Library added.
This is my macro:
Private Sub processParentTable()
Dim strTemp As String
Dim newString As String
Dim lineString As String
Dim startPos As Long
Dim endPos As Long
Dim myRange As Range
newString = ""
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="$$Interface Type", Forward:=True
If myRange.Find.found Then
myRange.Text = "Interface Type"
myRange.Expand Unit:=wdTable
myRange.Select
Dim noOfRows As Long
noOfRows = myRange.Rows.count
Dim i As Long
For i = 2 To noOfRows
Dim rowRange As Range
processSplitTables (myRange.Rows(i))
Next i
End If
End Sub
Private Sub processSplitTables(r As Range)
Dim Tbl As Table
Dim interfaceTypeCell As String
For Each Tbl In ActiveDocument.Tables
Set r = Tbl.Range
interfaceTypeCell = r.Cells(3).Range.Text
If interfaceTypeCell = "Interface Definition" Then
Dim interfaceType As Long
interfaceType = r.Text
If interfaceType = "Interface Definition" Then
Dim q As Long
For q = 1 To interfaceType
r.Expand Unit:=wdRow
r.Select
If r.Cells(1).RowIndex > 1 Then
r.Tables(1).Split r.Cells(1).RowIndex
End If
Next q
r.Shading.BackgroundPatternColor = wdColorLightYellow
End If
End If
Next
End Sub
Thank you very much!!!