The first red line counts only list paras outside the table.

The second count (in a table cell with a list) finds no list paras.

Any ideas how I can rectfy this

Cheers,

Mark

If vTab.Cell(1, gReqIdCol).Range.Characters.Count > 2 Then
temp = Application.ActiveWindow.Document.ListParagraphs.Count
MsgBox "There are " & temp & " paras."
With vTab.Cell(1, 1).Range
vFound = False
vIdx = 1
vLP = 1
Do
temptab = .ListParagraphs.Count
MsgBox "There are " & temptab & " paras in the cell."
If .ListParagraphs.Count > 0 Then
.ListParagraphs(2).Style = "BodyTextRequirementBullet"
vLP = vLP + 1
End If
Loop While vLP <= .ListParagraphs.Count
End With
End If

per our support engineer:

I have done some test. I got a different result of our ISV. With his code, I got all the para in the document.

temp = Application.ActiveWindow.Document.ListParagraphs.Count

MsgBox "There are " & temp & " paras."

On the other hand, I do not know the type of vTab. Would you please help me ask him to provide us a whole sample code

-brenda (ISV Buddy Team)

Brenda,

Thanks for your reply and sorry for the delay.

Cheers,

Mark

Here is all the code:

Option Explicit

Global gAuthorName As String
Global gArchive As String
Global gVersion As String
Global gStatus As String
Global gLocation As String
Global gProject As String
Global gDocTheme As String
Global gDocNumber As String
Global gAuthorDept As String
Global gDesignedName As String
Global gDesignedDept As String
Global gReleasedName As String
Global gReleasedDept As String

Global aColName() As String 'titles of columns
Global gColNum As Integer 'number of columns in table
Global gCol2Text As Integer 'number of columns extracted to text

Global Const cNoBorder = 0
Global Const c25Border = 1
Global Const c50Border = 2

Const cReqIdName = "REQID" 'compare text in upper case
Global gReqIdCol As Integer 'number of ReqId column, also used as switch

Sub P_Message(vType As String)
'******************************************************************************
' deliver a message for not yet implemented functions
'******************************************************************************

Dim vMsg As String
'------------------------------------------------------------------------------

vMsg = "Sorry, function " & Chr$(34) & vType & Chr$(34) & " not yet implemented."
MsgBox vMsg, vbInformation, "Requirement Specification"

End Sub

Sub FitGraphics()
'******************************************************************************
' FitGraphics Macro
' Macro written 19.06.2002 by Eberhard De Wille
'******************************************************************************

Dim x
Dim y
Dim f

Open ActiveDocument For Binary As #2
While EOF(2) = 0
Selection.GoTo What:=wdGoToGraphic, Which:=wdGoToNext, Count:=1, Name:=""
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
If Selection.InlineShapes(1).Width > 455 Then
x = Selection.InlineShapes(1).Width
y = Selection.InlineShapes(1).Height
f = 455 / x
y = y * f
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 455
Selection.InlineShapes(1).Height = y
End If
Selection.MoveDown Unit:=wdLine, Count:=1
Wend

End Sub

Sub P_About()
'******************************************************************************
' display About-Form with general information
'******************************************************************************

frmAbout.Show

End Sub

Sub P_CompareRequirements()
'******************************************************************************
' compare with former version of document
'******************************************************************************

Dim vFile As String
Dim vRet As Long
'------------------------------------------------------------------------------

Call P_UnlockSection
With Dialogs(wdDialogFileOpen)
vRet = .Display
If vRet = -1 Then vFile = CurDir$ & "\" & .Name
End With

If vRet = -1 Then
If Dir$(vFile) <> "" Then
ActiveDocument.Compare Name:=vFile
Else
MsgBox "Error: File not found", vbCritical
End If
End If

End Sub

Sub P_UpdateToc()
'******************************************************************************
' update table of contents
'******************************************************************************

Call P_UnlockSection
ActiveDocument.TablesOfContents(1).Update

End Sub

Sub P_LineNumbers()
'******************************************************************************
' toggle line numbers (on / off)
'******************************************************************************

Dim vRange As Range
'------------------------------------------------------------------------------

Call P_UnlockSection
Set vRange = ActiveDocument.Range(Start:=ActiveDocument.Sections(2).Range.Start, _
End:=ActiveDocument.Content.End)

With vRange.PageSetup
If .LineNumbering.Active = True Then
.LineNumbering.Active = False
Else
With .LineNumbering
.Active = True
.StartingNumber = 1
.CountBy = 1
.RestartMode = wdRestartPage
.DistanceFromText = wdAutoPosition
End With
End If
End With

End Sub

Sub P_UnlockSection()
'******************************************************************************
' unlock section 1 to edit abstract and history
'******************************************************************************

If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
End If

End Sub

Sub P_DocumentVariables()
'******************************************************************************
' define document variables (via user form)
'******************************************************************************

Call P_UnlockSection

gAuthorName = F_GetVariable("AuthorName")
gArchive = F_GetVariable("Archive")
gVersion = F_GetVariable("Version")
gStatus = F_GetVariable("Status")
gLocation = F_GetVariable("Location")
gProject = F_GetVariable("Project")
gDocTheme = F_GetVariable("DocTheme")
gDocNumber = F_GetVariable("DocNumber")
gAuthorDept = F_GetVariable("AuthorDept")
gDesignedName = F_GetVariable("DesignedName")
gDesignedDept = F_GetVariable("DesignedDept")
gReleasedName = F_GetVariable("ReleasedName")
gReleasedDept = F_GetVariable("ReleasedDept")

frmDocumentVariables.Show

End Sub

Sub P_VersionVariables()
'******************************************************************************
' define document variables of version (via user form)
'******************************************************************************

Call P_UnlockSection

gVersion = F_GetVariable("Version")
gStatus = F_GetVariable("Status")

frmVersionVariables.Show

End Sub

Sub P_UpdateVariables(vAll As Boolean)
'******************************************************************************
' update bookmark variables from user form
'******************************************************************************

Dim vFld As Field
Dim vSec As Section
Dim vPage As HeaderFooter
'------------------------------------------------------------------------------

Application.ScreenUpdating = False

'Version and Status are updated in any case
Call P_SetVariable("Version", gVersion)
Call P_SetVariable("Status", gStatus)

If vAll Then 'other Variables not from Version-Variables Form
Call P_SetVariable("AuthorName", gAuthorName)
Call P_SetVariable("Archive", gArchive)
Call P_SetVariable("Location", gLocation)
Call P_SetVariable("Project", gProject)
Call P_SetVariable("DocTheme", gDocTheme)
Call P_SetVariable("DocNumber", gDocNumber)
Call P_SetVariable("AuthorDept", gAuthorDept)
Call P_SetVariable("DesignedName", gDesignedName)
Call P_SetVariable("DesignedDept", gDesignedDept)
Call P_SetVariable("ReleasedName", gReleasedName)
Call P_SetVariable("ReleasedDept", gReleasedDept)
End If

'--- update REF fields in text ---
For Each vFld In ActiveDocument.Fields
If vFld.Type = wdFieldRef Then vFld.Update
Next vFld

'--- update REF fields in headers and footers of sections ---
For Each vSec In ActiveDocument.Sections
For Each vPage In vSec.Headers
For Each vFld In vPage.Range.Fields
If vFld.Type = wdFieldRef Then vFld.Update
Next vFld
Next vPage
For Each vPage In vSec.Footers
For Each vFld In vPage.Range.Fields
If vFld.Type = wdFieldRef Then vFld.Update
Next vFld
Next vPage
Next vSec

ActiveDocument.UndoClear
Application.ScreenUpdating = True

End Sub

Function F_GetVariable(vVarName As String) As String
'******************************************************************************
' get current value of a bookmark variable
'******************************************************************************

Dim vTmpValue As String
'------------------------------------------------------------------------------

If ActiveDocument.Bookmarks.Exists(vVarName) = True Then
vTmpValue = ActiveDocument.Bookmarks(vVarName).Range.Text
Else
MsgBox "Error: Bookmark " & vVarName & " not defined", vbExclamation
Exit Function
End If

F_GetVariable = vTmpValue

End Function

Sub P_SetVariable(vVarName As String, vVarValue As String)
'******************************************************************************
' set current value of bookmark variable
'******************************************************************************

Dim vFld As Field
Dim vFldType As String
Dim vCnt As Integer
'------------------------------------------------------------------------------

If ActiveDocument.Bookmarks.Exists(vVarName) = True Then
For Each vFld In ActiveDocument.Fields
If vFld.Type = wdFieldSet Then
vCnt = InStr(vFld.Code, vVarName)
If vCnt <> 0 Then
vFldType = Left(vFld.Code.Text, vCnt - 1)
vFld.Code.Text = vFldType & vVarName & " " & Chr$(34) & vVarValue & Chr$(34)
vFld.Update
End If
End If
Next vFld
Else
MsgBox "Error: Bookmark " & vVarName & " not defined", vbExclamation
End If

End Sub

Sub P_ReformatTable()
'******************************************************************************
' format selected columns of table as text
'******************************************************************************

Dim vIdx As Integer
'------------------------------------------------------------------------------

Call P_UnlockSection

'--- there must be at least one table in section 2 ---
If ActiveDocument.Sections(2).Range.Tables.Count = 0 Then
MsgBox "No Table found for Reformatting.", vbExclamation
Exit Sub
End If

'--- first table must have at least 2 rows (title + 1 Requirement) ---
If ActiveDocument.Sections(2).Range.Tables(1).Rows.Count < 2 Then
MsgBox "First Table has not enough Rows for Reformatting.", vbExclamation
Exit Sub
End If

'--- Cursor (=Selection) must be in table of section 2 ---
Selection.GoTo What:=wdGoToSection, Count:=2
If Selection.Information(wdWithInTable) = False Then
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext
End If

'--- set array for names of columns ---
gColNum = Selection.Tables(1).Columns.Count
ReDim aColName(1 To gColNum)
gReqIdCol = 0
For vIdx = 1 To gColNum
aColName(vIdx) = Selection.Tables(1).Cell(1, vIdx).Range.Text
If UCase(Left(aColName(vIdx), Len(cReqIdName))) = cReqIdName Then gReqIdCol = vIdx
Next vIdx

'--- display form for formatting parameters ---
frmFormatTable.Show

End Sub

Sub P_FormattingControl(vBorder As Integer)
'******************************************************************************
' re-formatting is done row by row
'******************************************************************************

Dim vIdx As Integer
Dim vRowCnt As Integer
Dim vLoopCnt As Integer
Dim vStatusText As String
Dim vMsg As String
Dim vTable As Table
Dim vStartPos As Long
Dim vViewType As Long
'------------------------------------------------------------------------------

'--- changes are not shown immediately on screen ---
Application.ScreenUpdating = False
vViewType = ActiveWindow.View.Type
ActiveWindow.View.Type = wdNormalView 'avoids re-pagination

'--- definitions for status bar ---
vRowCnt = Selection.Tables(1).Rows.Count
vStatusText = " of " & CStr(vRowCnt - 1) & " rows processed" '1st row to be deleted

' MWCHANGE
'--- paragraph formats already in table columns with Selection Object ---
'Application.StatusBar = "Replacing Paragraph-Formats in Columns"
Call P_ParagraphFormat(1, ActiveDocument.Styles(wdStyleBodyText).NameLocal)
For vIdx = 2 To gColNum
If vIdx <= gCol2Text Then
Selection.SelectCell
Call P_ParagraphFormat(vIdx, "TextFromColumn")
Else
Selection.SelectCell
Call P_ParagraphFormat(vIdx, "TextInColumn")
End If
Next vIdx

'--- apply requested border line to table ---
Application.StatusBar = "Changing Borders of Table"
Call P_TableFormat(Selection.Tables(1), vBorder)

Application.StatusBar = "Clearing Undo-List"
'ActiveDocument.UndoClear

'--- split table between each row and delete title row ---
Set vTable = Selection.Tables(1)
For vIdx = vRowCnt To 2 Step -1
vTable.Split BeforeRow:=vIdx
Next vIdx

Selection.Tables(1).Rows(1).Delete

'--- remember position before first table (remaining empty paragraph) ---
vStartPos = ActiveDocument.Sections(2).Range.Tables(1).Range.Start - 1

'--- reformat each row of original table ---
vRowCnt = vRowCnt - 1
vLoopCnt = 0
For vIdx = vRowCnt To 1 Step -1 'backwards! tables may be deleted
vLoopCnt = vLoopCnt + 1
Application.StatusBar = "Reformatting Table: " & CStr(vLoopCnt) & vStatusText
Call P_RowConvert(vIdx)
If (vLoopCnt Mod 200) = 0 Then ActiveDocument.UndoClear
Next vIdx

'--- previous start position is empty paragraph ---
ActiveDocument.Range(Start:=vStartPos, End:=vStartPos).Paragraphs(1).Range.Delete

'--- re-activate update of screen ---
'ActiveDocument.UndoClear
ActiveWindow.View.Type = vViewType
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.ScreenRefresh

'--- reminder for table of contents ---
vMsg = "Reformatting completed." & Chr$(13) & "Update Table of Contents now "
If MsgBox(vMsg, vbQuestion + vbYesNo) = vbYes Then Call P_UpdateToc

End Sub

Sub P_RowConvert(vTabNr As Integer)
'******************************************************************************
' re-format current row to text (selected columns)
'******************************************************************************

Dim vIdx As Integer
Dim vTable As Table
Dim vLength As Integer
Dim vSum As Integer
Dim vColDel As Integer
Dim vStyle As Style
Dim vRange As Range
Dim vCell As Cell
Dim vPos As Long
'------------------------------------------------------------------------------

Set vTable = ActiveDocument.Sections(2).Range.Tables(vTabNr)
vPos = vTable.Range.Start - 1

'--- if requested change format of requirements ---
If gReqIdCol <> 0 Then Call P_RequirementFormat(vTable)

'--- move text from selected columns to text body (before table) ---
For vIdx = 1 To gCol2Text
Set vCell = vTable.Cell(1, vIdx)
vLength = vCell.Range.Characters.Count - 1
If vLength > 0 Then
Set vRange = ActiveDocument.Range(Start:=vCell.Range.Start, End:=vCell.Range.End - 1)
If vRange.Characters.Last = vbCr Then 'could cause empty paragraph or heading
vRange.SetRange Start:=vRange.Start, End:=vRange.End - 1
End If
If vRange.Start <> vRange.End Then
Set vStyle = vRange.Paragraphs.Last.Style
vRange.FormattedText.Cut

ActiveDocument.Range(Start:=vPos, End:=vPos).InsertParagraphAfter
vPos = vPos + 1
If vIdx <> 1 Then 'insert title of column
ActiveDocument.Range(Start:=vPos, End:=vPos).Paragraphs(1).Style = "TitleOfColumn"
ActiveDocument.Range(Start:=vPos, End:=vPos).InsertAfter aColName(vIdx)
vPos = vTable.Range.Start - 1
End If
ActiveDocument.Range(Start:=vPos, End:=vPos).Paragraphs(1).Style = vStyle
ActiveDocument.Range(Start:=vPos, End:=vPos).Paste
vPos = vTable.Range.Start - 1
End If
End If
Next vIdx

'--- check content of remaining columns ---
vSum = 0
For vIdx = gCol2Text + 1 To gColNum
vSum = vSum + vTable.Cell(1, vIdx).Range.Characters.Count - 1
Next vIdx

If vSum > 0 Then 'add column titles to remaining columns
For vIdx = gCol2Text + 1 To gColNum
vTable.Cell(1, vIdx).Range.InsertBefore aColName(vIdx)
vTable.Cell(1, vIdx).Range.Paragraphs(1).Range.Style = "TitleOfColumn"
Next vIdx
For vIdx = 1 To gCol2Text
vTable.Columns(1).Delete 'always 1st column!
Next vIdx
vTable.Columns.AutoFit
Else 'all remaining columns are empty -> delete them
vTable.Delete
ActiveDocument.Range(Start:=vPos + 1, End:=vPos + 1).Paragraphs(1).Range.Delete
End If

End Sub

Sub P_ParagraphFormat(vCol As Integer, vStyle As String)
'******************************************************************************
' format paragraphs in table columns
'******************************************************************************
'Modified Mark Webster 7 June 2006
Selection.Tables(1).Columns(vCol).Select
Selection.Style = ActiveDocument.Styles(vStyle)
'Selection.Style = ActiveDocument.Styles("BodyTextRequirement")
'Selection.Find.ClearFormatting
'Selection.Find.Style = ActiveDocument.Styles(wdStyleNormal)
'Selection.Find.Replacement.ClearFormatting
'Selection.Find.Replacement.Style = ActiveDocument.Styles(vStyle)
'With Selection.Find
' .Text = ""
' .Replacement.Text = ""
' .Forward = True
' .Wrap = wdFindStop
' .Format = True
' .MatchCase = False
' .MatchWholeWord = False
' .MatchWildcards = False
' .MatchSoundsLike = False
' .MatchAllWordForms = False
'End With
'Selection.Find.Execute Replace:=wdReplaceAll
Selection.Collapse

End Sub

Sub P_RequirementFormat(vTab As Table)
'******************************************************************************
' special format for requirments (if not header)
'******************************************************************************

Dim vIdx As Integer
Dim vFound As Boolean
Dim vRowCnt As Integer
Dim para As Integer
Dim vLP As Integer
Dim temp As Integer
'------------------------------------------------------------------------------

If vTab.Cell(1, gReqIdCol).Range.Characters.Count > 2 Then
temp = Application.ActiveWindow.Document.ListParagraphs.Count
MsgBox "There are " & temp & " paras."
With vTab.Cell(1, 1).Range
vFound = False
vIdx = 1
vLP = 1
Do
temptab = .ListParagraphs.Count
MsgBox "There are " & temptab & " paras in the cell."
If .ListParagraphs.Count > 0 Then
.ListParagraphs(2).Style = "BodyTextRequirementBullet"
vLP = vLP + 1
End If
Loop While vLP <= .ListParagraphs.Count
'Loop While (vFound = False) And (vIdx <= vTab.Cell(1, 1).Range.Paragraphs.Count)
'If vFound Then vTab.Cell(1, 1).Range.Paragraphs(vIdx).Style = "BodyTextRequirement"
Do
'Modified Mark Webster 7 June 2006
If .Paragraphs(vIdx).Style = ActiveDocument.Styles(wdStyleBodyText).NameLocal Then
vFound = True
If vFound And vIdx = 1 Then .Paragraphs(vIdx).Style = "BodyTextRequirement"
If vFound And vIdx >= 2 Then .Paragraphs(vIdx).Style = "BodyTextRequirementContinue"
'If vFound And vIdx >= 2 And vTab.Cell(1, 1).Range.Paragraphs(vIdx).Range.ListParagraphs.Count > 0 Then vTab.Cell(1, 1).Range.Paragraphs(vIdx).Style = "BodyTextRequirementBullet"
'If vTab.Cell(1, 1).Range.Paragraphs(vIdx).Application.ListGalleries.Item(wdBulletGallery)
'Then vTab.Cell(1, 1).Range.Paragraphs(vIdx).Style = "BodyTextRequirementBullet"
vIdx = vIdx + 1
End If
Loop While vIdx <= .Paragraphs.Count
End With
End If

End Sub

Sub P_TableFormat(vTab As Table, vBorder As Integer)
'******************************************************************************
' format table: left indent, border lines
'******************************************************************************

With vTab
.Rows.SpaceBetweenColumns = CentimetersToPoints(0.3)
.Rows.LeftIndent = CentimetersToPoints(0.5)

If vBorder = c25Border Then
.Borders(wdBorderLeft).ColorIndex = wdGray25
.Borders(wdBorderRight).ColorIndex = wdGray25
.Borders(wdBorderTop).ColorIndex = wdGray25
.Borders(wdBorderBottom).ColorIndex = wdGray25
.Borders(wdBorderVertical).ColorIndex = wdGray25
ElseIf vBorder = c50Border Then
.Borders(wdBorderLeft).ColorIndex = wdGray50
.Borders(wdBorderRight).ColorIndex = wdGray50
.Borders(wdBorderTop).ColorIndex = wdGray50
.Borders(wdBorderBottom).ColorIndex = wdGray50
.Borders(wdBorderVertical).ColorIndex = wdGray50
Else
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
End If
.Borders.Shadow = False
End With

End Sub

per the support engineer:

After I researched the code of our ISV. I found that he used selection object in his code. Would you please let him confirmed that he is checking all the paras in his document, or the paras in selection.

And the code is one module in the project, would you please ask him to provider us a detail steps to reproduce his issue

1. How to deploy his code

2. Some other module, such as frmDocumentVariables is required.

3. Which is the main sub that we need to debug

4. What is the expect result of the sub, and what is the current result of the sub

-brenda (ISV Buddy Team)