Nested table question (W2003)
in [Word VBA]
|
Prev: Word-to-prn
Next: Word "File in use" message box
From: Greg Maxey on 22 Mar 2010 18:09 Let's revise that a little: 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 myVariable = CellText(ttCell, True) If Len(myVariable) > 0 Then MsgBox myVariable End If For Each Nest1Tbl In ttCell.Tables For Each nt1Cell In Nest1Tbl.Range.Cells If nt1Cell.Tables.Count > 0 Then myVariable = CellText(nt1Cell, True) If Len(myVariable) > 0 Then MsgBox myVariable End If For Each Nest2Tbl In nt1Cell.Tables For Each nt2Cell In Nest2Tbl.Range.Cells myVariable = CellText(nt2Cell, False) MsgBox myVariable Next nt2Cell Next Nest2Tbl Else myVariable = CellText(nt1Cell, False) MsgBox myVariable End If Next nt1Cell Next Nest1Tbl Else myVariable = CellText(ttCell, False) MsgBox myVariable End If Next ttCell Next TopTbl End Sub Function CellText(oCell As Word.Cell, bFirstLook As Boolean) Dim i As Long Dim oRng As Word.Range If bFirstLook Then With ActiveDocument .Range.InsertAfter vbCr Set oRng = .Range oRng.Collapse wdCollapseEnd .Bookmarks.Add "ScratchPad", oRng Set oRng = oCell.Range oRng.MoveEnd wdCharacter, -1 oRng.Copy Set oRng = .Bookmarks("ScratchPad").Range oRng.Paste .Bookmarks.Add "ScratchPad", oRng For i = 1 To oRng.Tables.Count oRng.Tables(i).Delete Next i CellText = oRng.Text On Error Resume Next .Bookmarks("ScratchPad").Range.Delete .Paragraphs.Last.Previous.Range.Delete On Error GoTo 0 End With Else CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) End If 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 >>>> Dim iSelectionColumnStart As Integer >>>> Dim lngStart As Long >>>> Dim lngEnd As Long >>>> Dim lngNestLvl As Long >>>> Dim pTableNumber As String >>>> >>>> ' Check if Selection IS in a table >>>> ' if not, exit Sub after message >>>> If Selection.Information(wdWithInTable) = False Then >>>> MsgBox "Selection is not in a table. Exiting macro." >>>> Else >>>> lngStart = Selection.Range.Start >>>> lngEnd = Selection.Range.End >>>> lngNestLvl = Selection.Cells.NestingLevel >>>> >>>> ' get the numbers for the END of the selection range >>>> iSelectionRowEnd = >>>> Selection.Information(wdEndOfRangeRowNumber) >>>> iSelectionColumnEnd = >>>> Selection.Information(wdEndOfRangeColumnNumber) >>>> >>>> ' collapse the selection range >>>> Selection.Collapse Direction:=wdCollapseStart >>>> >>>> ' get the numbers for the END of the selection range >>>> ' now of course the START of the previous selection >>>> iSelectionRowStart = >>>> Selection.Information(wdEndOfRangeRowNumber) >>>> iSelectionColumnStart = >>>> Selection.Information(wdEndOfRangeColumnNumber) >>>> >>>> ' RESELECT the same range >>>> Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - >>>> lngStart >>>> >>>> ' display the range of cells covered by the selection >>>> MsgBox ActiveDocument.Range(0, >>>> Selection.Tables(1).Range.End).Tables.Count & _ >>>> Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _ >>>> "The selection covers " & Selection.Cells.Count & " cells, >>>> from Cell(" & _ >>>> iSelectionRowStart & "," & iSelectionColumnStart & ") to >>>> Cell(" & _ iSelectionRowEnd & "," & iSelectionColumnEnd & >>>> ")." End If >>>> End Sub >>> >>> >>> .
From: ker_01 on 22 Mar 2010 18:22 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 > >>>> Dim iSelectionColumnStart As Integer > >>>> Dim lngStart As Long > >>>> Dim lngEnd As Long > >>>> Dim lngNestLvl As Long > >>>> Dim pTableNumber As String > >>>> > >>>> ' Check if Selection IS in a table > >>>> ' if not, exit Sub after message > >>>> If Selection.Information(wdWithInTable) = False Then > >>>> MsgBox "Selection is not in a table. Exiting macro." > >>>> Else > >>>> lngStart = Selection.Range.Start > >>>> lngEnd = Selection.Range.End > >>>> lngNestLvl = Selection.Cells.NestingLevel > >>>> > >>>> ' get the numbers for the END of the selection range > >>>> iSelectionRowEnd = > >>>> Selection.Information(wdEndOfRangeRowNumber) > >>>> iSelectionColumnEnd = > >>>> Selection.Information(wdEndOfRangeColumnNumber) > >>>> > >>>> ' collapse the selection range > >>>> Selection.Collapse Direction:=wdCollapseStart > >>>> > >>>> ' get the numbers for the END of the selection range > >>>> ' now of course the START of the previous selection > >>>> iSelectionRowStart = > >>>> Selection.Information(wdEndOfRangeRowNumber) > >>>> iSelectionColumnStart = > >>>> Selection.Information(wdEndOfRangeColumnNumber) > >>>> > >>>> ' RESELECT the same range > >>>> Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - > >>>> lngStart > >>>> > >>>> ' display the range of cells covered by the selection > >>>> MsgBox ActiveDocument.Range(0, > >>>> Selection.Tables(1).Range.End).Tables.Count & _ > >>>> Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _ > >>>> "The selection covers " & Selection.Cells.Count & " cells, > >>>> from Cell(" & _ > >>>> iSelectionRowStart & "," & iSelectionColumnStart & ") to > >>>> Cell(" & _ iSelectionRowEnd & "," & iSelectionColumnEnd & > >>>> ")." End If > >>>> End Sub > >>> > >>> > >>> . > > > . >
From: Greg Maxey on 22 Mar 2010 19:11 There's a plan. Try: 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 myVariable = CellText(ttCell, True) If Len(myVariable) > 0 Then MsgBox myVariable End If For Each Nest1Tbl In ttCell.Tables For Each nt1Cell In Nest1Tbl.Range.Cells If nt1Cell.Tables.Count > 0 Then myVariable = CellText(nt1Cell, True) If Len(myVariable) > 0 Then MsgBox myVariable End If For Each Nest2Tbl In nt1Cell.Tables For Each nt2Cell In Nest2Tbl.Range.Cells myVariable = CellText(nt2Cell, False) MsgBox myVariable Next nt2Cell Next Nest2Tbl Else myVariable = CellText(nt1Cell, False) MsgBox myVariable End If Next nt1Cell Next Nest1Tbl Else myVariable = CellText(ttCell, False) MsgBox myVariable End If Next ttCell Next TopTbl End Sub Function CellText(oCell As Word.Cell, bFirstLook As Boolean) Dim i As Long Dim pStr As String If bFirstLook Then pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2) For i = 1 To oCell.Tables.Count pStr = Replace(pStr, oCell.Tables(1).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 >>>>>> Dim iSelectionColumnStart As Integer >>>>>> Dim lngStart As Long >>>>>> Dim lngEnd As Long >>>>>> Dim lngNestLvl As Long >>>>>> Dim pTableNumber As String >>>>>> >>>>>> ' Check if Selection IS in a table >>>>>> ' if not, exit Sub after message >>>>>> If Selection.Information(wdWithInTable) = False Then >>>>>> MsgBox "Selection is not in a table. Exiting macro." >>>>>> Else >>>>>> lngStart = Selection.Range.Start >>>>>> lngEnd = Selection.Range.End >>>>>> lngNestLvl = Selection.Cells.NestingLevel >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> iSelectionRowEnd = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnEnd = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' collapse the selection range >>>>>> Selection.Collapse Direction:=wdCollapseStart >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> ' now of course the START of the previous selection >>>>>> iSelectionRowStart = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnStart = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' RESELECT the same range >>>>>> Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - >>>>>> lngStart >>>>>> >>>>>> ' display the range of cells covered by the selection >>>>>> MsgBox ActiveDocument.Range(0, >>>>>> Selection.Tables(1).Range.End).Tables.Count & _ >>>>>> Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _ >>>>>> "The selection covers " & Selection.Cells.Count & " cells, >>>>>> from Cell(" & _ >>>>>> iSelectionRowStart & "," & iSelectionColumnStart & ") to >>>>>> Cell(" & _ iSelectionRowEnd & "," & iSelectionColumnEnd & >>>>>> ")." End If >>>>>> End Sub >>>>> >>>>> >>>>> . >> >> >> .
From: Greg Maxey on 22 Mar 2010 20:05 Better yet would be to call a recursive procedure that drills down to the deepest nested tables: Option Explicit Dim myVariable Sub Main() Dim oTopTbl As Table For Each oTopTbl In ActiveDocument.Tables ProcessTables 1, oTopTbl Next oTopTbl End Sub Sub ProcessTables(lngNestingLevel As Long, _ oTable As Word.Table, Optional ByRef oTableMajor As Word.Table) Dim oCell As Word.Cell Dim oTableMinor As Word.Table For Each oCell In oTable.Range.Cells myVariable = CellText(oCell, True) If Len(myVariable) > 0 Then MsgBox myVariable 'Do something with your variable End If If oCell.Tables.Count > 0 Then For Each oTableMinor In oCell.Tables lngNestingLevel = oTableMinor.NestingLevel Set oTableMajor = oTableMinor 'Call recursive procedure to drill down to deepest nested table ProcessTables lngNestingLevel, oTableMinor, oTableMajor 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 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 >>>>>> Dim iSelectionColumnStart As Integer >>>>>> Dim lngStart As Long >>>>>> Dim lngEnd As Long >>>>>> Dim lngNestLvl As Long >>>>>> Dim pTableNumber As String >>>>>> >>>>>> ' Check if Selection IS in a table >>>>>> ' if not, exit Sub after message >>>>>> If Selection.Information(wdWithInTable) = False Then >>>>>> MsgBox "Selection is not in a table. Exiting macro." >>>>>> Else >>>>>> lngStart = Selection.Range.Start >>>>>> lngEnd = Selection.Range.End >>>>>> lngNestLvl = Selection.Cells.NestingLevel >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> iSelectionRowEnd = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnEnd = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' collapse the selection range >>>>>> Selection.Collapse Direction:=wdCollapseStart >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> ' now of course the START of the previous selection >>>>>> iSelectionRowStart = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnStart = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' RESELECT the same range >>>>>> Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - >>>>>> lngStart >>>>>> >>>>>> ' display the range of cells covered by the selection >>>>>> MsgBox ActiveDocument.Range(0, >>>>>> Selection.Tables(1).Range.End).Tables.Count & _ >>>>>> Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _ >>>>>> "The selection covers " & Selection.Cells.Count & " cells, >>>>>> from Cell(" & _ >>>>>> iSelectionRowStart & "," & iSelectionColumnStart & ") to >>>>>> Cell(" & _ iSelectionRowEnd & "," & iSelectionColumnEnd & >>>>>> ")." End If >>>>>> End Sub >>>>> >>>>> >>>>> . >> >> >> .
From: Greg Maxey on 23 Mar 2010 08:49
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 >>>>>> Dim iSelectionColumnStart As Integer >>>>>> Dim lngStart As Long >>>>>> Dim lngEnd As Long >>>>>> Dim lngNestLvl As Long >>>>>> Dim pTableNumber As String >>>>>> >>>>>> ' Check if Selection IS in a table >>>>>> ' if not, exit Sub after message >>>>>> If Selection.Information(wdWithInTable) = False Then >>>>>> MsgBox "Selection is not in a table. Exiting macro." >>>>>> Else >>>>>> lngStart = Selection.Range.Start >>>>>> lngEnd = Selection.Range.End >>>>>> lngNestLvl = Selection.Cells.NestingLevel >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> iSelectionRowEnd = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnEnd = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' collapse the selection range >>>>>> Selection.Collapse Direction:=wdCollapseStart >>>>>> >>>>>> ' get the numbers for the END of the selection range >>>>>> ' now of course the START of the previous selection >>>>>> iSelectionRowStart = >>>>>> Selection.Information(wdEndOfRangeRowNumber) >>>>>> iSelectionColumnStart = >>>>>> Selection.Information(wdEndOfRangeColumnNumber) >>>>>> >>>>>> ' RESELECT the same range >>>>>> Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - >>>>>> lngStart >>>>>> >>>>>> ' display the range of cells covered by the selection >>>>>> MsgBox ActiveDocument.Range(0, >>>>>> Selection.Tables(1).Range.End).Tables.Count & _ >>>>>> Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _ >>>>>> "The selection covers " & Selection.Cells.Count & " cells, >>>>>> from Cell(" & _ >>>>>> iSelectionRowStart & "," & iSelectionColumnStart & ") to >>>>>> Cell(" & _ iSelectionRowEnd & "," & iSelectionColumnEnd & >>>>>> ")." End If >>>>>> End Sub >>>>> >>>>> >>>>> . >> >> >> . |