Map2Table-Dev.mmbas

'******************** ' 18Jan2010 Map2table.mmap  http://creativecommons.org/licenses/by-sa/3.0/ http://www.activityowner.com ' Export the first 3 layers of a map to html ' Choose 1st layer=columns, 2nd layer= rows, and 3rd layer=entries/hyperlinks '   or  1st layer=rows, 2nd layer=columns, and 3rd =entries '******************** '#uses "ao_common.mmbas" Option Explicit Sub Main Dim mains(150) As String 'assume <150 unique strings in each layer Dim subs(150) As String Dim temp(150) As String 'for copying over Dim swap As String Dim entries(1000) As Topic 'assume <1000 third layer entries Dim maintext(1000) As Integer Dim subtext(1000) As Integer Dim mcount As Integer Dim scount As Integer Dim ecount As Integer Dim tempcount As Integer Dim f As String Dim mindex As Integer Dim sindex As Integer Dim autoopen As Boolean Dim include_link As Boolean Dim use_this_link As Boolean Dim include_notes As Boolean Dim bullet As Boolean Dim mark_no_children As Boolean Dim shorten_entries As Boolean Dim found As Boolean Dim mfound As Boolean Dim sfound As Boolean Dim first As Boolean Dim i As Integer Dim j As Integer Dim k As Integer Dim addr As String Dim txt As String Dim imark As String Dim omark As String Dim tasks As String Dim main_as_row As Boolean Dim parenttopic As Topic Dim mtopic As Topic Dim stopic As Topic Dim sstopic As Topic Dim tasktopic As Topic '4th layer items Dim separator As String Dim max_length As Integer Dim answer As Integer Dim doc As Document Dim usedefaults As Boolean Dim guid As String Dim prefix As String Dim postfix As String

max_length		=180 '--  	mcount=0				'initialize unique string counts scount=0               ' ecount=0 usedefaults=Command="default" Set doc=ActiveDocument 'lock onto active document If doc.IsModified Then doc.Save 'MsgBox("Save document before running map2table") 'make sure we have an html name/destination Exit Sub End If '-Decide parent to work from-- If Not doc.Selection.PrimaryTopic Is Nothing Then If Not doc.Selection.PrimaryTopic.IsCentralTopic Then answer= MsgBox("Run on Branch" & doc.Selection.PrimaryTopic.Text & "?",vbYesNoCancel) If answer=vbYes Then Set parenttopic=doc.Selection.PrimaryTopic End If		  	If answer=vbNo Then Set parenttopic=doc.CentralTopic End If		  	If answer=vbCancel Then Exit Sub End If  		Else Set parenttopic=doc.CentralTopic End If  	Else Set parenttopic=doc.CentralTopic End If  If usedefaults Then main_as_row = False Else main_as_row=MsgBox("Do you want Main topics listed as Rows?",vbYesNo)=vbYes End If

'-MAP2TABLE OPTIONS-- autoopen		=True	'auto open html file? If usedefaults Then include_link=True include_notes=False Else include_link 	= MsgBox("Include Hyperlinks?",vbYesNo)=vbYes 	'include hyperlinks in html table include_notes   = MsgBox("Include Notes?",vbYesNo)=vbYes 'add notes under entries End If mark_no_children= True 'add * if no children under entry (e.g. no next actions) separator 		=" "	'Can separate table entries with " ", " ", Or "," If Not include_notes Then shorten_entries = True	'shorten long entries to end with ... depending on number of columns present If Not usedefaults Then bullet = MsgBox("Include Bullets",vbYesNo)=vbYes     'bullets in table by setting to false Else bullet=False End If  	Else bullet = False shorten_entries=False End If

'Make lists of 1st/2nd layer words and index 3rd layer-- For Each mtopic In parenttopic.AllSubTopics 'make list of unique 1st layer topics mfound=False For i=1 To mcount If mtopic.Text=mains(i) Then mfound=True mindex=i Exit For End If      	Next If Not mfound Then mcount=mcount+1 mindex=mcount mains(mcount)=mtopic.Text End If      	For Each stopic In mtopic.AllSubTopics 'make list of 2nd layer topics sfound=False sindex=0 For i=1 To scount If stopic.Text=subs(i) Then sfound=True sindex=i Exit For End If      		Next If Not sfound Then scount=scount+1 sindex=scount subs(scount)=stopic.Text End If      		For Each sstopic In stopic.AllSubTopics ecount=ecount+1 Set entries(ecount)=sstopic subtext(ecount)=sindex maintext(ecount)=mindex Next Next Next

For i=1 To scount-1 'sort rows For j=i+1 To scount If subs(i)>subs(j) Then swap=subs(i) subs(i)=subs(j) subs(j)=swap For k=1 To ecount If subtext(k)=i Then subtext(k)=j ElseIf subtext(k)=j Then subtext(k)=i End If			Next End If     Next Next

If main_as_row Then 'move main to temp tempcount=scount For i=1 To scount temp(i)=subs(i) Next scount=mcount For i=1 To mcount subs(i)=mains(i) Next mcount=tempcount For i=1 To mcount mains(i)=temp(i) Next For i = 1 To ecount j=subtext(i) subtext(i)=maintext(i) maintext(i)=j Next End If

'--	'decide whether to make topics with no subtopics show in italics 'if no entry has children then don't bother marking everything found=False For Each mtopic In parenttopic.AllSubTopics For Each stopic In mtopic.AllSubTopics For Each sstopic In stopic.AllSubTopics If sstopic.AllSubTopics.Count>0 Then found=True Next Next Next If Not found Then mark_no_children=False ' 'Start outputting info - f=Replace(doc.FullName,".mmap",".html") 'save doc to same location as map Open f For Output As #1 Print #1, "   " Close #1 '---View the report If autoopen Then Shell("C:\Program Files\Internet Explorer\iexplore.exe "&f,1) End If End Sub