A CHAOS MANOR SPECIAL REPORT

Saturday, June 16, 2001

Here is a programmatic solution. It can be called from a toolbar shortcut, if you want to take the trouble:
 

 
Sub CountNonblankLines()
Dim parA        As Paragraph
Dim rngSaveSel  As Range
Dim TextLines   As Long
Dim StartLine   As Long
Dim EndLine     As Long
 

Set rngSaveSel = Selection.Range                'save the current cursor location
TextLines = 0
For Each parA In ActiveDocument.Content.Paragraphs
    parA.Range.Select
    If Len(Trim$(parA.Range.Text)) > 2 Then     'skip empty paragraphs
        Selection.Collapse (wdCollapseStart)
        StartLine = Selection.Information(wdFirstCharacterLineNumber)
        parA.Range.Select
        Selection.Collapse (wdCollapseEnd)
        EndLine = Selection.Information(wdFirstCharacterLineNumber) - 1
                    

        TextLines = TextLines + (EndLine - StartLine + 1)
    End If
Next parA
 

ActiveDocument.Content.Select
Selection.Collapse (wdCollapseEnd)
MsgBox "Non-blank lines = " &; TextLines &; vbCrLf &; _
        "Total lines in document = " &; _
        Selection.Information(wdFirstCharacterLineNumber) - 1
 

rngSaveSel.Select
 

End
 

End Sub

' CountNonBlankLines() by steve@hastings.org
'
' Counts non-blank lines in the active document.  The definition
' of a non-blank line is any line with at least one character on it.
' Even a space or a tab is enough to make a line "non-blank".

Sub CountNonBlankLines()
    Dim CurrentPara As Paragraph

    Dim NumBlankLines As Long
    Dim NumLines As Long

    If ActiveDocument.ActiveWindow.Selection.Range.Words.Count >= 2 Then
        MsgBox "Warning: counting words in entire document, not just in selection!"
    End If

    Set CurrentPara = ActiveDocument.Paragraphs(1)

    NumBlankLines = 0
    NumLines = 0

    Do While (Not CurrentPara Is Nothing)
        Dim LinesTemp As Long

        LinesTemp = CurrentPara.Range.ComputeStatistics(wdStatisticLines)

        If CurrentPara.Range.Words.Count <= 1 Then  'null paragraph contains one word!
            NumBlankLines = NumBlankLines + LinesTemp
        Else
            NumLines = NumLines + LinesTemp
        End If

        Set CurrentPara = CurrentPara.Next
    Loop

    MsgBox "Number of blank lines: " &; NumBlankLines &; vbNewLine &; "Number of non-blank lines: " &; NumLines

End Sub 'CountNonBlankLines

TOP