Help!

Org Chart Wizard Help

 
  

Post new topic   General Reply to Topic (not reply to a specific post)    Forums Home -> TroubleShooting RSS
Next:  Visio 2007 + Error #3400  
Author Message
GaryP
External


Since: Jun 08, 2007
Posts: 2



PostPosted: Tue Jun 26, 2007 6:45 am    Post subject: Org Chart Wizard Help
Archived from groups: microsoft>public>visio>troubleshoot (more info?)

Hello,
I have written vba code in a template that executes the org chart wizard
(see below). When the org chart wizard is complete, I have some code that I
need to exeute that color codes the shapes of the newly created chart. The
problem that I am having is the chart is created in another instance of Visio
and the code that I need to execute is within the template. Is there a way
to execute this code against the new diagram?
Thanks in advance,
Gary

CHART WIZARD LOGIC
Set objVisio = CreateObject("Visio.Application")
Set objAddOn = objVisio.Addons.ItemU("OrgCWiz")

strFile = "v:\Element Table (Gary) new link IT.xls"
strDisplayFields = "TITLE, PERCENTAGE"
strPropertyFields = "COLOR_CODE"

strCommand = "/FILENAME=" & strFile _
& " /NAME-FIELD=ID " _
& " /UNIQUEID-FIELD=ID " _
& " /MANAGER-FIELD=Report To IT " _
& " /DISPLAY-FIELDS=" & strDisplayFields _
& " /CUSTOM-PROPERTY-FIELDS=" & strPropertyFields _
& " /SYNC-ACROSS-PAGES " _
& " /HYPERLINK-ACROSS-PAGES " _
& " /SHAPE-FIELD=MASTER_SHAPE "

objAddOn.Run ("/S-INIT")

Dim cmdArray, i
cmdArray = Split(strCommand, "/")
For i = LBound(cmdArray) To UBound(cmdArray)
objAddOn.Run ("/S-ARGSTR /" + cmdArray(i))
Next

objAddOn.Run ("/S-RUN ")



COLOR CODING LOGIC

Private Sub ColorCodeOrgChart()
Dim PagsObj As Visio.Pages
Dim PagObj As Visio.Page

Set PagsObj = ActiveDocument.Pages

For Each PagObj In PagsObj
ActiveWindow.Page = PagObj.Name
Call CustomProp
Next PagObj
End Sub
Private Sub CustomProp()
Dim shpObj As Visio.Shape, celObj As Visio.Cell
Dim i As Integer, ShpNo As Integer, TotalShapes As Integer, shpCount As
Integer
Dim ValName As String, Tabchr As String

Tabchr = Chr(9)
TotalShapes = Round(Visio.ActivePage.Shapes.Count / 2)
shpCount = Visio.ActivePage.Shapes.Count - (TotalShapes * 2)
If TotalShapes = 0 Then
TotalShapes = TotalShapes + 1
End If

If shpCount = 1 Then
TotalShapes = TotalShapes + 1
End If

For ShpNo = 0 To TotalShapes
Set shpObj = Visio.ActivePage.Shapes(ShpNo)
Set celObj = shpObj.CellsSRC(Visio.visSectionProp, 1, 0)
ValName = celObj.ResultStr(Visio.visNone)
If ValName = "Yellow" Then
Debug.Print shpObj.Name; " "; shpObj.Cells("Fillforegnd")
shpObj.Cells("Fillforegnd") = 5
End If
If ValName = "Green" Then
Debug.Print shpObj.Name; " "; shpObj.Cells("Fillforegnd")
shpObj.Cells("Fillforegnd") = 3
End If
If ValName = "Red" Then
Debug.Print shpObj.Name; " "; shpObj.Cells("Fillforegnd")
shpObj.Cells("Fillforegnd") = 2
End If
If ValName = "Blue" Then
Debug.Print shpObj.Name; " "; shpObj.Cells("Fillforegnd")
shpObj.Cells("Fillforegnd") = 4
End If
Next ShpNo
End Sub
Back to top
Display posts from previous:   
Post new topic   General Reply to Topic (not reply to a specific post)    Forums Home -> TroubleShooting All times are: Eastern Time (US & Canada) (change)
Page 1 of 1

 
You can post new topics in this forum
You can reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum