'ANNOTDOC.BAS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Annotate a document                                                 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Main As String

Dim page,tb,toptb As Object, pname,s,c As String
Dim ntb,l,t,w,h,ll,tt,k,le,counter,npage As Integer
Dim message As String

   npage=ActiveDocument.Count
   counter=0
   For Each page In ActiveDocument
       With page.TextBoxes
           ntb=.Count
           If ntb>0 Then
               toptb=.Item(1)
               toptb.GetBound(ll,tt,w,h)
               For Each tb In .Self
                   tb.GetBound(l,t,w,h)
                   If ((t<tt) Or ((t=tt) And (l<ll))) Then
                       toptb=tb
                       toptb.GetBound(ll,tt,w,h)
                   End If
               Next tb
               pname=toptb.GetContent
               le=Len(pname)
               s=""
               For k=1 To le
                   c=Mid(pname,k,1)
                   If c<>Chr(13) And c<>Chr(10) Then s=s+c
               Next k
               page.SetName(s)
               counter=counter+1
           End If
       End With
    Next page
    If counter=0 Then
        Main="Nothing to do."+Chr(13)+Chr(13)+"Pages contain no text."
    Else
        If counter<npage Then
            Main=Str(counter)+" of "+Str(npage)+" pages were successfully annotated." +Chr(13)+Chr(13)+"Other "+Str(npage-counter)+" pages contain no text."+Chr(13)+Chr(13)+"To see page names click on the page counter from the bottom status line."
        Else
            Main="The whole document was successfully annotated."+Chr(13)+Chr(13)+"All pages were named."+Chr(13)+Chr(13)+"To see page names click on the page counter from the bottom status line." 
        End If
    End If
    
End Function
