' --------------------------------------------------------------------- '' Copyright ©1999-2009 Shyam Pillai. All Rights Reserved. ' --------------------------------------------------------------------- ' You are free to use this code within your own applications, add-ins, ' documents etc but you are expressly forbidden from selling or ' otherwise distributing this source code without prior consent. ' This includes both posting free demo projects made from this ' code as well as reproducing the code in text or html format. ' ---------------------------------------------------------------------
'================== Code Module ===============
Option Explicit
Sub Guides()
Dim oParser As XMLParser
Dim sngOrientation As Single
Dim sngPosition As Single
Dim I As Integer
Set oParser = New XMLParser
With oParser
.XMLString = ActivePresentation.HTMLProject_
.HTMLProjectItems("pres.xml").Text
Call .ReadGuidesPosition("guide")
Debug.Print "Total guides:" & .Count
For I = 0 To .Count - 1
Call .GetGuideInfo(I, sngOrientation, sngPosition)
Debug.Print sngOrientation, sngPosition
Next I
End With
Set oParser = Nothing
End Sub
'================== Clsss Module - XMLParser ===============
Option Explicit
Const READYSTATE_COMPLETE = 4
' Requires a reference to the XML parser 2.6
Dim WithEvents xml_document As DOMDocument
Private mvarXMLString As String
Private mvarNode As String
Private mvarNodeAttribute As String
Private mvarAttributeValue As String
Private mvarGuideCount As String
Private iGuideInfo(16, 2) As Single
' Traverse the DOM Nodes
Private Sub DisplayDomNode(ByRef xml_node As MSXML2.IXMLDOMNode)
Dim str_line As String
Dim lng_loop As Long
If xml_node Is Nothing Then
Exit Sub
End If
If (xml_node.nodeType = NODE_ELEMENT) Then
If xml_node.baseName = mvarNode Then
If xml_node.Attributes(0).nodeValue = "vertical" Then
iGuideInfo(mvarGuideCount, 0) = 0
Else
iGuideInfo(mvarGuideCount, 0) = 1
End If
iGuideInfo(mvarGuideCount, 1) = Val(xml_node.Attributes(1).nodeValue)
mvarGuideCount = mvarGuideCount + 1
End If
End If
If Not (xml_node.childNodes Is Nothing) Then
For lng_loop = 0 To xml_node.childNodes.Length - 1
Call DisplayDomNode(xml_node.childNodes.Item(lng_loop))
Next lng_loop
End If
End Sub
Private Sub Class_Terminate()
Erase iGuideInfo
End Sub
'-------------------------------------------------------------------------
' DOM Event Handlers
'-------------------------------------------------------------------------
Private Sub xml_document_onreadystatechange()
Dim xml_parseError As MSXML2.IXMLDOMParseError
Dim xml_node As MSXML2.IXMLDOMNode
'check if the document reference's status is complete
If (xml_document.readyState = READYSTATE_COMPLETE) Then
'get a reference to the parseerror object
Set xml_parseError = xml_document.parseError
'check if an error occured
If TypeName(xml_document.documentElement) = "Nothing" Then
MsgBox xml_parseError.reason, vbOKOnly
Else
Set xml_node = xml_document
'Parse the XML for our desired attribute
Call DisplayDomNode(xml_node)
End If
End If
End Sub
Private Sub Class_Initialize()
Set xml_document = CreateObject("Microsoft.XMLDOM")
xml_document.async = True
End Sub
Sub ReadGuidesPosition(Node As String)
mvarNode = Node
mvarGuideCount = 0
xml_document.loadXML mvarXMLString
End Sub
Public Property Let XMLString(ByVal vData As String)
mvarXMLString = vData
End Property
Public Property Get XMLString() As String
XMLString = mvarXMLString
End Property
Public Sub GetGuideInfo(Index As Integer, _
ByRef GuideOrientation As Single, _
ByRef Position As Single)
On Error Resume Next
GuideOrientation = iGuideInfo(Index, 0)
Position = iGuideInfo(Index, 1)
End Sub
Public Property Get Count() As Integer
Count = mvarGuideCount
End Property
|