Import data from Access to a Visio Timeline

[Aaron]

Hello all,

Is there a way to import data from Access to a Visio timeline? I've read a
couple of posts, but I have not been able to fully impliment it. Examples
would be great.

Thanks in advance,
Aaron

 

[Al Edlund]

Is your difficulty in the access or in the visio? The reason for the focus
is it can get pretty large otherwise.
Al

 

[Aaron]

The problem has been on the Visio side, having the milestone dates match up
with what I set them at.

Thanks,
Aaron

 

[Al Edlund]

I use something like this to plot the events involved with monitoring
network trouble tickets.
Al


Public Sub subCreateTimeLine(ByVal strTimeLineId As String, _
ByVal dateBeginTicket As Date, _
ByVal dateEndTicket As Date)

Dim objApp As Visio.Application
Dim objPage As Visio.Page
Dim objShape As Visio.Shape
Dim objShapeGrp As Visio.Shape
Dim objcell As Visio.Cell
Dim intResult As Integer
Dim dblDateTime As Double
Dim objAddOn As Object
Dim dblDuration As Double


On Error GoTo CreateTimeLine_err

Set objApp = Me.DrawingControl.Window.Application
Set objAddOn = objApp.Addons.Item("ts")
Set objPage = objApp.ActivePage

objApp.AlertResponse = 1

Set objShape = funcDropMasterOnPage(objPage, _
"Cylindrical timeline", _
"TIMELN_U.VSS", _
5.75, _
7, _
visInches)

DoEvents
objApp.AlertResponse = 0

' first we want to change the scales
If objShape.CellExists("user.vistimescale", False) Then
Set objcell = objShape.Cells("user.vistimescale")
objcell.Formula = StringToFormulaForString("3")
' Debug.writeline "set timescale"
End If

If objShape.CellExists("user.visminortimescale", False) Then
Set objcell = objShape.Cells("user.visminortimescale")
objcell.Formula = StringToFormulaForString("2")
' Debug.writeline "set minorscale"
End If

objShape.Name = strTimeLineId
Application.DoEvents
' do a tickle to the add on to change the scale
objApp.AlertResponse = 1
objAddOn.Run ("/cmd=3")
objApp.AlertResponse = 0

' now update the times
Set objcell = objShape.Cells("user.visbegindate")
objcell.Formula = CDbl(dateBeginTicket)

Set objcell = objShape.Cells("user.visenddate")
objcell.Formula = CDbl(dateEndTicket)
DoEvents

' this stuff calls the timeline config so that
' we can update the picture
objApp.AlertResponse = 1
objAddOn.Run ("/cmd=3")
objApp.AlertResponse = 0

Exit Sub
CreateTimeLine_exit:

CreateTimeLine_err:

Resume Next

End Sub

Public Sub subDrawTicketEvents()

Dim arrTicket() As String
Dim arrTicketEvents() As String
Dim intRecCnt As Integer
Dim intFldCnt As Integer
Dim intX As Integer
Dim intY As Integer
Dim dateBeginTicket As Date
Dim dateEndTicket As Date
Dim dateEvent As Date
Dim objApp As Visio.Application


Set objApp = Me.DrawingControl.Window.Application

'create the time line shell

subCreateTimeLine modRules.strTicketId, _
modRules.dateTicketBegin, _
modRules.dateTicketEnd

' our detail data is stored in an array (arrTicketAudit)
' so first get the number of audit train entries
intRecCnt = UBound(modRules.arrTicketAudit, 1)
' and then get the number of fields in a audit array
intFldCnt = UBound(modRules.arrTicketAudit, 2)

' now lets put in the event data
'
' by turning off updating until we are done we improve
performance
objApp.ScreenUpdating = False

For intX = 1 To intRecCnt
dateEvent = arrTicketAudit(intX, 2)
subCreateTimeEvent "abc", dateEvent
DoEvents
Next intX


objApp.ScreenUpdating = True
objApp.Window.DeselectAll

MsgBox ("Draw Complete")


End Sub

 

[Al Edlund]

Aaron,
as an aside this code is for v2003. The add-on and commands for v2002 are
slightly different but can be discovered by looking at the shape sheet for
the timeline shapes.
Al

Public Sub subCreateTimeEvent(ByVal strEventId As String, _
ByVal dateEvent As Date)

Dim objApp As Visio.Application
Dim objPage As Visio.Page
Dim objShapeGrp As Visio.Shape
Dim objcell As Visio.Cell
Dim intResult As Integer
Dim dblDateTime As Double

Set objApp = Me.DrawingControl.Window.Application
Set objPage = objApp.ActivePage

Dim objAddOn As Object
Set objAddOn = objApp.Addons.Item("ts")

objApp.AlertResponse = 1

Set objShapeGrp = funcDropMasterOnPage(objPage, _
"Cylindrical milestone", _
"TIMELN_U.VSS", _
5.3, _
6, _
visInches)

objShapeGrp.Text = strEventId

DoEvents
objApp.AlertResponse = 0

Set objcell = objShapeGrp.Cells("user.vismilestonedate")
objcell.Formula = CDbl(dateEvent)
Set objcell = objShapeGrp.Cells("user.vismask")
objcell.Formula = """{M/d HH:mm}}"""

' this stuff calls the event config so that
' we can update the picture
objApp.AlertResponse = 1
objAddOn.Run ("/cmd=4")
objApp.AlertResponse = 0


End Sub

 

[Aaron]

Thanks for the help! I'll try it out today.


Aaron

 

[Aaron]

Finally getting to this.

You don't happen to have the code you used for "funcDropMasterOnPage" handy
would you?

Thanks again!
Aaron

 

[Al Edlund]

That's the easiest because it is part of the v2003 SDK which can be
downloaded for free.
Al

 

[Aaron]

Suppose it isn't available/don't work for 2000?

That's the easiest because it is part of the v2003 SDK which can be
downloaded for free.
Al

 

[Al Edlund]

Aaron,
the basic shape manipulation hasn't changed a great deal since then. The
major changes is in event handling. More important is what version of
timeline addon is installed in v2000????

' modDropMasterOnPage / DropMasterOnPage.bas
' Copyright (c) Microsoft Corporation. All rights reserved.
'
' Summary:
' This module demonstrates how to drop a master onto a page at a
' specific location.


Public Function DropMasterOnPage(vsoPage As Visio.Page, _
strMasterNameU As String, _
strStencilName As String, _
dblPinX As Double, _
dblPinY As Double, _
varUnits As Variant) As Visio.shape

' DropMasterOnPage
'
' Abstract - This function finds the document with the
' strStencilName parameter from the Documents collection.
' If the document is not open, then open the stencil. Find
' the master within that stencil and drop it on to the page.
'
' Parameters
' vsoPage The page where the master will be dropped
' strMasterNameU Universal name of master in the stencil
' strStencilName Name of the Stencil from which the master
' is to be found
' dblPinX X-coordinate of the Pin in varUnits units
' dblPinY Y-coordinate of the Pin in varUnits units
' varUnits Units used by dblPinX and dblPinY
'
' Return Value Shape that was created by dropping the master on the page
' indicated by the vsoPage parameter

Dim vsoApplication As Visio.Application
Dim vsoDocuments As Visio.Documents
Dim vsoDocument As Visio.Document
Dim vsoMaster As Visio.Master
Dim dblPinXInternal As Double
Dim dblPinYInternal As Double
Dim vsoCellPinX As Visio.Cell
Dim vsoCellPinY As Visio.Cell

On Error Resume Next

' Find the stencil in the Document collection by name.
Set vsoDocuments = vsoPage.Application.Documents
Set vsoDocument = vsoDocuments.Item(strStencilName)

' If the stencil is not there, open it as a
' docked stencil.
If vsoDocument Is Nothing Then
Set vsoDocument = vsoDocuments.OpenEx( _
strStencilName, visOpenDocked)
End If

On Error GoTo DropMasterOnPage_Err

' Get the master on the stencil by using its universal
' name.
Set vsoMaster = vsoDocument.Masters.ItemU( _
strMasterNameU)

' Convert the PinX and PinY into internal units
Set vsoApplication = vsoPage.Application
dblPinXInternal = vsoApplication.ConvertResult(dblPinX, _
varUnits, visInches)
dblPinYInternal = vsoApplication.ConvertResult(dblPinY, _
varUnits, visInches)

' Drop the master on the page that is passed in.
' Set the PinX and PinY using the parameters
' dblPinXInternal and dblPinYInternal respectively.
Set DropMasterOnPage = vsoPage.Drop(vsoMaster, _
dblPinXInternal, dblPinYInternal)

' Update the units of the shape's PinX and PinY
Set vsoCellPinX = DropMasterOnPage.CellsSRC(visSectionObject, _
visRowXFormOut, visXFormPinX)
Set vsoCellPinY = DropMasterOnPage.CellsSRC(visSectionObject, _
visRowXFormOut, visXFormPinY)

vsoCellPinX.result(varUnits) = dblPinX
vsoCellPinY.result(varUnits) = dblPinY

Exit Function

DropMasterOnPage_Err:
Debug.Print Err.Description

End Function