🚀 go-pugleaf

Phil--

Check this out--I think it does what you want to do (it creates a silly example document that would demonstrate the AutoTag problem, then correctly marks it up--I think<g>):



Private Sub Command1_Click() 
Dim myInDesign As InDesign.Application 
Set myInDesign = CreateObject("InDesign.Application.2.0") 
Set myDocument = myInDesign.Documents.Add 
Rem Create some example paragraph styles 
Set myHeadingStyle = myDocument.ParaStyles.Add 
myHeadingStyle.Name = "heading" 
myHeadingStyle.FillColor = myDocument.Colors.Item("Magenta") 
Set myBodyTextStyle = myDocument.ParaStyles.Add 
myBodyTextStyle.Name = "body_text" 
Rem Create three XML tags 
Set myXMLStoryTag = myDocument.XMLTags.Add("story") 
Set myXMLHeadingTag = myDocument.XMLTags.Add("heading") 
Set myXMLBodyTextTag = myDocument.XMLTags.Add("body_text") 
Set myTextFrame = myDocument.Pages.Item(1).TextFrames.Add 
myTextFrame.GeometricBounds = myGetBounds(myDocument.Pages.Item(1), myDocument) 
Set myStory = myTextFrame.ParentStory 
Rem Add text to the story 
myString = "His and Her Circumstances (Kare Kano)" & vbCr & "High school romance comedy." & vbCr 
myString = myString & "Child's Toy (Kodomo No Omocha/Kodocha)" & vbCr & "Elementary school romance comedy." & vbCr 
myString = myString & "El Hazard" & vbCr & "Interdimensional science fiction/fantasy romance comedy with an Arabian Nights flavor." & vbCr 
myString = myString & "Other interesting titles:" & vbCr 
myString = myString & "Revolutionary Girl Utena" & vbCr & "Serial Experiments Lain" & vbCr & "Martian Successor Nadesico" & vbCr & "Neon Genesis Evangelion" & vbCr 
myStory.TextContents = myString 
Rem Apply paragraph styles. 
myStory.Paragraphs.Item(1).ParagraphStyle = myHeadingStyle 
myStory.Paragraphs.Item(2).ParagraphStyle = myBodyTextStyle 
myStory.Paragraphs.Item(3).ParagraphStyle = myHeadingStyle 
myStory.Paragraphs.Item(4).ParagraphStyle = myBodyTextStyle 
myStory.Paragraphs.Item(5).ParagraphStyle = myHeadingStyle 
myStory.Paragraphs.Item(6).ParagraphStyle = myBodyTextStyle 
myStory.Paragraphs.Item(7).ParagraphStyle = myHeadingStyle 
For myCounter = 8 To myStory.Paragraphs.Count 
    myStory.Paragraphs.Item(myCounter).ParagraphStyle = myBodyTextStyle 
Next 
myTagParaStyles myInDesign, myDocument, myXMLStoryTag 
End Sub 
Private Function myGetBounds(myPage, myDocument) 
    myPageHeight = myDocument.DocumentPreferences.PageHeight 
    myPageWidth = myDocument.DocumentPreferences.PageWidth 
    myX1 = myPage.MarginPreferences.MarginLeft 
    myY1 = myPage.MarginPreferences.MarginTop 
    myY2 = myPageHeight - myPage.MarginPreferences.MarginBottom 
    myX2 = myPageWidth - myPage.MarginPreferences.MarginRight 
    myGetBounds = Array(myY1, myX1, myY2, myX2) 
End Function

Private Sub myTagParaStyles(myInDesign, myDocument, myStoryTag) 
Dim myXMLTag As InDesign.XMLTag 
Rem Clear the find/change preferences 
myInDesign.FindPreferences = idNothing 
myInDesign.ChangePreferences = idNothing 
For myStoryCounter = 1 To myDocument.Stories.Count 
    Set myStory = myDocument.Stories.Item(myStoryCounter) 
    Set myXMLStory = myDocument.XMLElements.Add(myStoryTag, myStory.TextFrames.Item(1)) 
    For myStyleCounter = 1 To myDocument.ParaStyles.Count 
        If myDocument.ParaStyles.Item(myStyleCounter).Name <> "[No paragraph style]" Then 
            Set myParaStyle = myDocument.ParaStyles.Item(myStyleCounter) 
            Rem Disable error trapping 
            Err.Clear 
            On Error Resume Next 
            Set myXMLTag = myDocument.XMLTags.Item(myParaStyle.Name) 
            If Err.Number <> 0 Then 
                Set myXMLTag = myDocument.XMLTags.Add 
                myXMLTag.Name = myParaStyle.Name 
                Err.Clear 
            End If 
            Rem Restore error trapping 
            On Error GoTo 0 
            myDocument.Parent.FindPreferences.ParagraphStyle = myParaStyle 
            Set myFoundItems = myStory.Search("") 
            For myCounter = 1 To myFoundItems.Count 
                Set myFoundItem = myFoundItems.Item(myCounter) 
                For myParaCounter = myFoundItem.Paragraphs.Count To 1 Step -1 
                    Set myParagraph = myFoundItem.Paragraphs.Item(myParaCounter) 
                    Rem scan for XML tag marker characters at the start of the paragraph 
                    For myStartIndex = 1 To myParagraph.Characters.Count 
                        If myGetUnicodeString(myParagraph.Characters.Item(myStartIndex)) <> "<FEFF>" Then 
                            Exit For 
                        End If 
                    Next 
                    Rem check for a return at the end of the paragraph 
                    If myParagraph.Characters.Item(-1).TextContents = vbCr Then 
                        myCharacterCount = myParagraph.Characters.Count - 1 
                    Else 
                        myCharacterCount = myParagraph.Characters.Count 
                    End If 
                    Rem scan for xml tag marker characters at the end of a paragraph 
                    For myEndIndex = myCharacterCount To myStartIndex Step -1 
                        If myGetUnicodeString(myParagraph.Characters.Item(myEndIndex)) <> "<FEFF>" Then 
                            Exit For 
                        End If 
                    Next 
                    Set myStartCharacter = myParagraph.Characters.Item(myStartIndex) 
                    Set myEndCharacter = myParagraph.Characters.Item(myEndIndex) 
                    Set myText = myParagraph.Characters.ItemByRange(myStartCharacter, myEndCharacter).Item(1) 
                    Set myXMLElement = myXMLStory.XMLElements.Add(myXMLTag, myText) 
                Next 
            Next 
        End If 
    Next 
Next 
End Sub 
Private Function myGetUnicodeString(myText) 
Rem Get Unicode String 
myString = "" 
Set myCharacter = myText.Characters.ItemByRange(myText.Characters.Item(1), myText.Characters.Item(myText.Characters.Count)).Item(1) 
myContents = myCharacter.TextContents 
For myCounter = 1 To Len(myContents) 
    myCharacter = Mid(myContents, myCounter, 1) 
    If AscW(myCharacter) < 0 Or AscW(myCharacter) > 255 Then 
        myString = myString & "<" & CStr(Hex(AscW(myCharacter))) & ">" 
    Else 
        myPadString = "" 
        myLength = 4 - Len(CStr(Hex(AscW(myCharacter)))) 
        For myPadCounter = 1 To myLength 
            myPadString = myPadString & "0" 
        Next 
        myString = myString & "<" & myPadString & Hex(AscW(myCharacter)) & ">" 
    End If 
Next 
myGetUnicodeString = myString 
End Function 




If this seems to work, try adding the subroutine (myTagParaStyles) and the function (myGetUnicodeString) to your project--you should be able to use myTagParaStyles in place of the AutoTag method.

Thanks,

Ole