Home | VBA Section | General Section | Downloads | Licensing | Privacy Policy | OfficeTips RSS Feed

How to retrieve guide information

 

You can create up to 8 vertical guides and 8 horizontal guides. However the PowerPoint object model does not provide methods to access them or set them for a given presentation thru VBA code.

 

In PowerPoint version 2000 and above it is possible to read the XML information associated with the presentation from the Microsoft Script Editor and retrieve these values or even set them. This example provides an example of how to read the information of guides available.
 

We make use of the Microsoft XML parser to arrive at the information. Please note that depending upon the number of slides in the presentation, the Microsoft Script Editor will take some time to load and that causes a hit in execution time.

 
' ---------------------------------------------------------------------
'' 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
 
 

Copyright © 1999-2009 Shyam Pillai. All rights reserved.