Nested table question (W2003)
in [Word VBA]
|
Prev: Word-to-prn
Next: Word "File in use" message box
From: ker_01 on 23 Mar 2010 11:33 That is sweet code- I'm just a hack (never had any professional programming training) so I'm happy just when things work... but I can appreciate the gleam of my reflection in this elegant cannonball. :) Keith "Greg Maxey" wrote: > Just polishing the cannon ball now. There was some extraneous code in the > earlier versions: > > Sub Main() > Dim oTopTbl As Table > For Each oTopTbl In ActiveDocument.Tables > ProcessTables oTopTbl > Next oTopTbl > End Sub > > Sub ProcessTables(oTableMajor As Word.Table) > Dim oCell As Word.Cell > Dim oTableMinor As Word.Table > Dim pCellText As String > For Each oCell In oTableMajor.Range.Cells > 'Extract cell text > pCellText = CellText(oCell, True) > If Len(pCellText) > 0 Then > MsgBox pCellText 'Do something with your variable > End If > If oCell.Tables.Count > 0 Then > For Each oTableMinor In oCell.Tables > Set oTableMajor = oTableMinor > 'Call recursive procedure to drill down to deepest nested table > ProcessTables oTableMinor > Next > End If > Next oCell > End Sub > > Function CellText(oCell As Word.Cell, bFirstLook As Boolean) > Dim i As Long > Dim pStr As String > If bFirstLook Then 'Exclude text contained in nested tables. > pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) > For i = 1 To oCell.Tables.Count > pStr = Replace(pStr, oCell.Tables(i).Range.Text, "") > Next i > CellText = pStr > Else > CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) > End If > End Function > > > ker_01 wrote: > > Thanks Greg! (You rock) > > > > I was already starting to cobble something together, starting with > > the full cell contents, then in each sub-loop, using Replace to > > replace the child cell's string with a null string, thereby leaving > > only the parent cell string by the end of the loop. I think I've > > almost got it working, but if I don't get it soon I'll just abandon > > my attempt and use your rockin' code below. > > > > When I first started this workaround I was doing it just for the > > learning, I had hoped that there would be some part of the object > > model that would allow the selection of just the parent layer of text > > 8-/ > > > > Thanks again for all your help! > > Keith > > > > "Greg Maxey" wrote: > > > >> AFAIK, the only thing to do is cobble something together so that any > >> text in a cell that is part of a nested table is stripped out. > >> Something like this perhaps: > >> > >> Option Explicit > >> Sub CellContent() > >> Dim TopTbl As Table > >> Dim Nest1Tbl As Table 'First nesting level > >> Dim Nest2Tbl As Table 'Second nesting level > >> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell > >> Dim oRng As Word.Range > >> Dim i As Long > >> Dim myVariable > >> Set oRng = ActiveDocument.Range > >> oRng.Collapse wdCollapseEnd > >> ActiveDocument.Bookmarks.Add "ScratchPad", oRng > >> For Each TopTbl In ActiveDocument.Tables > >> For Each ttCell In TopTbl.Range.Cells > >> If ttCell.Tables.Count > 0 Then > >> Set oRng = ttCell.Range > >> oRng.MoveEnd wdCharacter, -1 > >> oRng.Copy > >> Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range > >> oRng.Paste > >> ActiveDocument.Bookmarks.Add "ScratchPad", oRng > >> For i = 1 To oRng.Tables.Count > >> oRng.Tables(i).Delete > >> Next i > >> myVariable = oRng.Text > >> MsgBox myVariable > >> For Each Nest1Tbl In ttCell.Tables > >> For Each nt1Cell In Nest1Tbl.Range.Cells > >> If nt1Cell.Tables.Count > 0 Then > >> Set oRng = nt1Cell.Range > >> oRng.MoveEnd wdCharacter, -1 > >> oRng.Copy > >> Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range > >> oRng.Paste > >> ActiveDocument.Bookmarks.Add "ScratchPad", oRng > >> For i = 1 To oRng.Tables.Count > >> oRng.Tables(i).Delete > >> Next i > >> myVariable = oRng.Text > >> MsgBox myVariable > >> For Each Nest2Tbl In nt1Cell.Tables > >> For Each nt2Cell In Nest2Tbl.Range.Cells > >> myVariable = CellText(nt2Cell) > >> MsgBox myVariable > >> Next nt2Cell > >> Next Nest2Tbl > >> Else > >> myVariable = CellText(nt1Cell) > >> MsgBox myVariable > >> End If > >> Next nt1Cell > >> Next Nest1Tbl > >> Else > >> myVariable = CellText(ttCell) > >> MsgBox myVariable > >> End If > >> Next ttCell > >> Next TopTbl > >> ActiveDocument.Bookmarks("ScratchPad").Range.Delete > >> End Sub > >> Function CellText(oCell As Word.Cell) > >> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) > >> End Function > >> > >> > >> > >> ker_01 wrote: > >>> I tried the simple answer of just grabbing the parent cell contents, > >>> but that passes along the nested cell contents (all of them) as part > >>> of the parent cell. > >>> > >>> Is there a way to grab the parent cell contents and specifically > >>> exclude any nested cells from that content? > >>> > >>> Thank you! > >>> Keith > >>> > >>> Sub CellContent() > >>> Dim TopTbl As Table > >>> Dim Nest1Tbl As Table 'First nesting level > >>> Dim Nest2Tbl As Table 'Second nesting level > >>> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell > >>> Dim myVariable > >>> For Each TopTbl In ActiveDocument.Tables > >>> For Each ttCell In TopTbl.Range.Cells > >>> myVariable = CellText(ttCell) '<---return includes nested cell > >>> contents 'Process myVariable > >>> If ttCell.Tables.Count > 0 Then > >>> For Each Nest1Tbl In ttCell.Tables > >>> For Each nt1Cell In Nest1Tbl.Range.Cells > >>> If nt1Cell.Tables.Count > 0 Then > >>> For Each Nest2Tbl In nt1Cell.Tables > >>> For Each nt2Cell In Nest2Tbl.Range.Cells > >>> myVariable = CellText(nt2Cell) > >>> 'Process myVariable > >>> Next nt2Cell > >>> Next Nest2Tbl > >>> Else > >>> myVariable = CellText(nt1Cell) > >>> 'Process myVariable > >>> End If > >>> Next nt1Cell > >>> Next Nest1Tbl > >>> Else > >>> myVariable = CellText(ttCell) > >>> 'Process myVariable > >>> End If > >>> Next ttCell > >>> Next TopTbl > >>> End Sub > >>> > >>> Function CellText(oCell As Word.Cell) > >>> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) > >>> End Function > >>> > >>> > >>> > >>> "ker_01" wrote: > >>> > >>>> Wow! Greg, your code is amazing. I've already run it, and checked > >>>> it against a sample document. The only thing it seems to miss is > >>>> the cell contents in a parent table cell if there is a nested table > >>>> present in that same cell (probably just the ordering of the If > >>>> statements). Once I figure that tidbit out, then I can get into the > >>>> real grunt work of comparing each cell to the template to remove > >>>> the original strings and only return the actual user entry data > >>>> from each cell. > >>>> > >>>> Thank you very very much- and if you are ever around the Redmond > >>>> area, I'll buy you the beverage of your choice. > >>>> > >>>> Thanks, > >>>> Keith > >>>> > >>>> "Greg Maxey" wrote: > >>>> > >>>>> Perhaps something like this would work for you: > >>>>> > >>>>> Sub CellContent() > >>>>> Dim TopTbl As Table > >>>>> Dim Nest1Tbl As Table 'First nesting level > >>>>> Dim Nest2Tbl As Table 'Second nesting level > >>>>> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As > >>>>> Word.Cell Dim myVariable > >>>>> For Each TopTbl In ActiveDocument.Tables > >>>>> For Each ttCell In TopTbl.Range.Cells > >>>>> If ttCell.Tables.Count > 0 Then > >>>>> For Each Nest1Tbl In ttCell.Tables > >>>>> For Each nt1Cell In Nest1Tbl.Range.Cells > >>>>> If nt1Cell.Tables.Count > 0 Then > >>>>> For Each Nest2Tbl In nt1Cell.Tables > >>>>> For Each nt2Cell In Nest2Tbl.Range.Cells > >>>>> myVariable = CellText(nt2Cell) > >>>>> 'Process myVariable > >>>>> Next nt2Cell > >>>>> Next Nest2Tbl > >>>>> Else > >>>>> myVariable = CellText(nt1Cell) > >>>>> 'Process myVariable > >>>>> End If > >>>>> Next nt1Cell > >>>>> Next Nest1Tbl > >>>>> Else > >>>>> myVariable = CellText(ttCell) > >>>>> 'Process myVariable > >>>>> End If > >>>>> Next ttCell > >>>>> Next TopTbl > >>>>> End Sub > >>>>> > >>>>> Function CellText(oCell As Word.Cell) > >>>>> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) > >>>>> End Function > >>>>> > >>>>> > >>>>> > >>>>> > >>>>> > >>>>> > >>>>> "ker_01" <ker01(a)discussions.microsoft.com> wrote in message > >>>>> news:E339C386-DD53-47BF-973A-FF6ED3A0B744(a)microsoft.com... > >>>>>> This is a followup to my thread from the end of last week; > >>>>>> > >>>>>> I'm working with a document format that someone else created, and > >>>>>> I need to > >>>>>> extract the data from various table (and nested table) cells in a > >>>>>> reliable fashion. > >>>>>> > >>>>>> I'm now able to determine what cell of a table I'm in, and at > >>>>>> what level of > >>>>>> "nesting". There is one piece still eluding me. In this template, > >>>>>> I have at > >>>>>> least one situation where the parent table has multiple nested > >>>>>> tables *in the > >>>>>> same cell*. So in the parent table's cell (1,1) I have a 2x2 > >>>>>> child table, then some text in the parent table cell, then > >>>>>> another 2x2 child table still > >>>>>> in that same parent cell. > >>>>>> > >>>>>> If I am looping through every cell in every table, and then every > >>>>>> cell in every sub-table (in whatever order; I can re-arrange the > >>>>>> data later), how do > >>>>>> I differentiate between child table 1 and child table 2 in the > >>>>>> same parent table cell? > >>>>>> > >>>>>> My desired end product will be something like the following, but > >>>>>> since I don't know the Word object model, I'm backing into it: > >>>>>> > >>>>>> For each table in document.tables > >>>>>> For each cell in table.cells > >>>>>> 'For each subtable in table.cell ? > >>>>>> 'For each cell in subtable ? > >>>>>> MyVariable = cell.range.text > >>>>>> 'do my processing > >>>>>> 'Next > >>>>>> 'Next > >>>>>> Next > >>>>>> Next > >>>>>> > >>>>>> I appreciate any suggestions! > >>>>>> Thank you, > >>>>>> Keith > >>>>>> > >>>>>> Current code, which is designed just to verify the current > >>>>>> location/table: > >>>>>> > >>>>>> Sub LocationMacro() > >>>>>> > >>>>>> Dim iSelectionRowEnd As Integer > >>>>>> Dim iSelectionRowStart As Integer > >>>>>> Dim iSelectionColumnEnd As Integer
From: Greg Maxey on 23 Mar 2010 17:09
Keith, Then we make a pair of hacks ;-). Glad I could help. If I ever come to Redmond, I'll come be thirsty. ker_01 wrote: > That is sweet code- I'm just a hack (never had any professional > programming training) so I'm happy just when things work... but I can > appreciate the gleam of my reflection in this elegant cannonball. > :) > Keith > > "Greg Maxey" wrote: > >> Just polishing the cannon ball now. There was some extraneous code >> in the earlier versions: >> >> Sub Main() >> Dim oTopTbl As Table >> For Each oTopTbl In ActiveDocument.Tables >> ProcessTables oTopTbl >> Next oTopTbl >> End Sub >> >> Sub ProcessTables(oTableMajor As Word.Table) >> Dim oCell As Word.Cell >> Dim oTableMinor As Word.Table >> Dim pCellText As String >> For Each oCell In oTableMajor.Range.Cells >> 'Extract cell text >> pCellText = CellText(oCell, True) >> If Len(pCellText) > 0 Then >> MsgBox pCellText 'Do something with your variable >> End If >> If oCell.Tables.Count > 0 Then >> For Each oTableMinor In oCell.Tables >> Set oTableMajor = oTableMinor >> 'Call recursive procedure to drill down to deepest nested table >> ProcessTables oTableMinor >> Next >> End If >> Next oCell >> End Sub >> >> Function CellText(oCell As Word.Cell, bFirstLook As Boolean) >> Dim i As Long >> Dim pStr As String >> If bFirstLook Then 'Exclude text contained in nested tables. >> pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) >> For i = 1 To oCell.Tables.Count >> pStr = Replace(pStr, oCell.Tables(i).Range.Text, "") >> Next i >> CellText = pStr >> Else >> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) >> End If >> End Function >> >> >> ker_01 wrote: >>> Thanks Greg! (You rock) >>> >>> I was already starting to cobble something together, starting with >>> the full cell contents, then in each sub-loop, using Replace to >>> replace the child cell's string with a null string, thereby leaving >>> only the parent cell string by the end of the loop. I think I've >>> almost got it working, but if I don't get it soon I'll just abandon >>> my attempt and use your rockin' code below. >>> >>> When I first started this workaround I was doing it just for the >>> learning, I had hoped that there would be some part of the object >>> model that would allow the selection of just the parent layer of >>> text 8-/ >>> >>> Thanks again for all your help! >>> Keith >>> >>> "Greg Maxey" wrote: >>> >>>> AFAIK, the only thing to do is cobble something together so that >>>> any text in a cell that is part of a nested table is stripped out. >>>> Something like this perhaps: >>>> >>>> Option Explicit >>>> Sub CellContent() >>>> Dim TopTbl As Table >>>> Dim Nest1Tbl As Table 'First nesting level >>>> Dim Nest2Tbl As Table 'Second nesting level >>>> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell >>>> Dim oRng As Word.Range >>>> Dim i As Long >>>> Dim myVariable >>>> Set oRng = ActiveDocument.Range >>>> oRng.Collapse wdCollapseEnd >>>> ActiveDocument.Bookmarks.Add "ScratchPad", oRng >>>> For Each TopTbl In ActiveDocument.Tables >>>> For Each ttCell In TopTbl.Range.Cells >>>> If ttCell.Tables.Count > 0 Then >>>> Set oRng = ttCell.Range >>>> oRng.MoveEnd wdCharacter, -1 >>>> oRng.Copy >>>> Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range >>>> oRng.Paste >>>> ActiveDocument.Bookmarks.Add "ScratchPad", oRng >>>> For i = 1 To oRng.Tables.Count >>>> oRng.Tables(i).Delete >>>> Next i >>>> myVariable = oRng.Text >>>> MsgBox myVariable >>>> For Each Nest1Tbl In ttCell.Tables >>>> For Each nt1Cell In Nest1Tbl.Range.Cells >>>> If nt1Cell.Tables.Count > 0 Then >>>> Set oRng = nt1Cell.Range >>>> oRng.MoveEnd wdCharacter, -1 >>>> oRng.Copy >>>> Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range >>>> oRng.Paste >>>> ActiveDocument.Bookmarks.Add "ScratchPad", oRng >>>> For i = 1 To oRng.Tables.Count >>>> oRng.Tables(i).Delete >>>> Next i >>>> myVariable = oRng.Text >>>> MsgBox myVariable >>>> For Each Nest2Tbl In nt1Cell.Tables >>>> For Each nt2Cell In Nest2Tbl.Range.Cells >>>> myVariable = CellText(nt2Cell) >>>> MsgBox myVariable >>>> Next nt2Cell >>>> Next Nest2Tbl >>>> Else >>>> myVariable = CellText(nt1Cell) >>>> MsgBox myVariable >>>> End If >>>> Next nt1Cell >>>> Next Nest1Tbl >>>> Else >>>> myVariable = CellText(ttCell) >>>> MsgBox myVariable >>>> End If >>>> Next ttCell >>>> Next TopTbl >>>> ActiveDocument.Bookmarks("ScratchPad").Range.Delete >>>> End Sub >>>> Function CellText(oCell As Word.Cell) >>>> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) >>>> End Function >>>> >>>> >>>> >>>> ker_01 wrote: >>>>> I tried the simple answer of just grabbing the parent cell >>>>> contents, but that passes along the nested cell contents (all of >>>>> them) as part of the parent cell. >>>>> >>>>> Is there a way to grab the parent cell contents and specifically >>>>> exclude any nested cells from that content? >>>>> >>>>> Thank you! >>>>> Keith >>>>> >>>>> Sub CellContent() >>>>> Dim TopTbl As Table >>>>> Dim Nest1Tbl As Table 'First nesting level >>>>> Dim Nest2Tbl As Table 'Second nesting level >>>>> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As >>>>> Word.Cell Dim myVariable >>>>> For Each TopTbl In ActiveDocument.Tables >>>>> For Each ttCell In TopTbl.Range.Cells >>>>> myVariable = CellText(ttCell) '<---return includes nested >>>>> cell contents 'Process myVariable >>>>> If ttCell.Tables.Count > 0 Then >>>>> For Each Nest1Tbl In ttCell.Tables >>>>> For Each nt1Cell In Nest1Tbl.Range.Cells >>>>> If nt1Cell.Tables.Count > 0 Then >>>>> For Each Nest2Tbl In nt1Cell.Tables >>>>> For Each nt2Cell In Nest2Tbl.Range.Cells >>>>> myVariable = CellText(nt2Cell) >>>>> 'Process myVariable >>>>> Next nt2Cell >>>>> Next Nest2Tbl >>>>> Else >>>>> myVariable = CellText(nt1Cell) >>>>> 'Process myVariable >>>>> End If >>>>> Next nt1Cell >>>>> Next Nest1Tbl >>>>> Else >>>>> myVariable = CellText(ttCell) >>>>> 'Process myVariable >>>>> End If >>>>> Next ttCell >>>>> Next TopTbl >>>>> End Sub >>>>> >>>>> Function CellText(oCell As Word.Cell) >>>>> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) >>>>> End Function >>>>> >>>>> >>>>> >>>>> "ker_01" wrote: >>>>> >>>>>> Wow! Greg, your code is amazing. I've already run it, and checked >>>>>> it against a sample document. The only thing it seems to miss is >>>>>> the cell contents in a parent table cell if there is a nested >>>>>> table present in that same cell (probably just the ordering of >>>>>> the If statements). Once I figure that tidbit out, then I can >>>>>> get into the real grunt work of comparing each cell to the >>>>>> template to remove the original strings and only return the >>>>>> actual user entry data from each cell. >>>>>> >>>>>> Thank you very very much- and if you are ever around the Redmond >>>>>> area, I'll buy you the beverage of your choice. >>>>>> >>>>>> Thanks, >>>>>> Keith >>>>>> >>>>>> "Greg Maxey" wrote: >>>>>> >>>>>>> Perhaps something like this would work for you: >>>>>>> >>>>>>> Sub CellContent() >>>>>>> Dim TopTbl As Table >>>>>>> Dim Nest1Tbl As Table 'First nesting level >>>>>>> Dim Nest2Tbl As Table 'Second nesting level >>>>>>> Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As >>>>>>> Word.Cell Dim myVariable >>>>>>> For Each TopTbl In ActiveDocument.Tables >>>>>>> For Each ttCell In TopTbl.Range.Cells >>>>>>> If ttCell.Tables.Count > 0 Then >>>>>>> For Each Nest1Tbl In ttCell.Tables >>>>>>> For Each nt1Cell In Nest1Tbl.Range.Cells >>>>>>> If nt1Cell.Tables.Count > 0 Then >>>>>>> For Each Nest2Tbl In nt1Cell.Tables >>>>>>> For Each nt2Cell In Nest2Tbl.Range.Cells >>>>>>> myVariable = CellText(nt2Cell) >>>>>>> 'Process myVariable >>>>>>> Next nt2Cell >>>>>>> Next Nest2Tbl >>>>>>> Else >>>>>>> myVariable = CellText(nt1Cell) >>>>>>> 'Process myVariable >>>>>>> End If >>>>>>> Next nt1Cell >>>>>>> Next Nest1Tbl >>>>>>> Else >>>>>>> myVariable = CellText(ttCell) >>>>>>> 'Process myVariable >>>>>>> End If >>>>>>> Next ttCell >>>>>>> Next TopTbl >>>>>>> End Sub >>>>>>> >>>>>>> Function CellText(oCell As Word.Cell) >>>>>>> CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) >>>>>>> End Function >>>>>>> >>>>>>> >>>>>>> >>>>>>> >>>>>>> >>>>>>> >>>>>>> "ker_01" <ker01(a)discussions.microsoft.com> wrote in message >>>>>>> news:E339C386-DD53-47BF-973A-FF6ED3A0B744(a)microsoft.com... >>>>>>>> This is a followup to my thread from the end of last week; >>>>>>>> >>>>>>>> I'm working with a document format that someone else created, >>>>>>>> and I need to >>>>>>>> extract the data from various table (and nested table) cells >>>>>>>> in a reliable fashion. >>>>>>>> >>>>>>>> I'm now able to determine what cell of a table I'm in, and at >>>>>>>> what level of >>>>>>>> "nesting". There is one piece still eluding me. In this >>>>>>>> template, I have at >>>>>>>> least one situation where the parent table has multiple nested >>>>>>>> tables *in the >>>>>>>> same cell*. So in the parent table's cell (1,1) I have a 2x2 >>>>>>>> child table, then some text in the parent table cell, then >>>>>>>> another 2x2 child table still >>>>>>>> in that same parent cell. >>>>>>>> >>>>>>>> If I am looping through every cell in every table, and then >>>>>>>> every cell in every sub-table (in whatever order; I can >>>>>>>> re-arrange the data later), how do >>>>>>>> I differentiate between child table 1 and child table 2 in the >>>>>>>> same parent table cell? >>>>>>>> >>>>>>>> My desired end product will be something like the following, >>>>>>>> but since I don't know the Word object model, I'm backing into >>>>>>>> it: >>>>>>>> >>>>>>>> For each table in document.tables >>>>>>>> For each cell in table.cells >>>>>>>> 'For each subtable in table.cell ? >>>>>>>> 'For each cell in subtable ? >>>>>>>> MyVariable = cell.range.text >>>>>>>> 'do my processing >>>>>>>> 'Next >>>>>>>> 'Next >>>>>>>> Next >>>>>>>> Next >>>>>>>> >>>>>>>> I appreciate any suggestions! >>>>>>>> Thank you, >>>>>>>> Keith >>>>>>>> >>>>>>>> Current code, which is designed just to verify the current >>>>>>>> location/table: >>>>>>>> >>>>>>>> Sub LocationMacro() >>>>>>>> >>>>>>>> Dim iSelectionRowEnd As Integer >>>>>>>> Dim iSelectionRowStart As Integer >>>>>>>> Dim iSelectionColumnEnd As Integer |