Macro does not fire from Web-part

P

PP

Hi All

I have a visio diagram, which works sucessfully on my local box, but fails inside the Windows Share Point (WSS) web-part.
Here is some information about VISIO doc:
It has 6 shape objects. What I do is, on_load of this visio document, I read an XML file (read the value of one of the node), based on this value the the back-ground color of the SHAPE object is changed.

Note: This XML file gets created by Infopath, so in-reality it shouldn't make any different. Correct? :)

On my local machine, the color changes, but within the WSS, it does not work at all.

Can anybody please tell me what could be the issue.
I have the code below for my VISIO.

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
'Declare object variables as Visio object types.
Dim vsoPage As Visio.Page
Dim vsoDocument As Visio.Document
Dim vsoDocuments As Visio.Documents
Dim vsoPages As Visio.Pages
Dim vsoItem As Visio.Shape
Dim vsoItems As Visio.Shapes

'Iterate through all open documents.
Set vsoDocuments = Application.Documents

'----------------------------------------------
Dim plainColor As Integer
Dim fillColor As Integer
plainColor = 1
fillColor = 13 '6 : Pink, 13 : Green
'----------------------------------------------

'----------------------------------------------
Dim vsoStyles As Visio.Styles
Dim vsoStyle As Visio.Style
'----------------------------------------------

'----------------------------------------------
' Read XML file
'----------------------------------------------
Dim xmlDoc, nodes, ApprovedStatus
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = "false"
'xmlDoc.Load ("c:\Request.xml")
xmlDoc.Load ("\\milkyway\i$\Request.xml")
'xmlDoc.Load ("http://proposal5/RFPHome/PDDS/Proposals Forms/request.xml")

Set nodes = xmlDoc.documentElement.childNodes
'MsgBox (nodes.Item(0).Text) ' -- <my:rtbHeader>
'MsgBox (nodes.Item(54).Text) ' -- <my:field54>
ApprovedStatus = CInt(nodes.Item(54).Text)
'----------------------------------------------

For Each vsoDocument In vsoDocuments
'Debug.Print vsoDocument.FullName
'Iterate through all pages in a drawing.
Set vsoPages = vsoDocument.Pages
For Each vsoPage In vsoPages
'MsgBox (vsoPage.Name)
Set vsoItems = vsoPage.Shapes
For Each vsoItem In vsoItems
'MsgBox (vsoItem.Name)
'MsgBox vsoItem.Application
If Len(vsoItem.Name) >= 7 Then
If LCase(Mid(vsoItem.Name, 1, 7)) = "process" Then
'MsgBox vsoItem.Characters.Text
'---------------------------------------------------
' Now filling color in the boxes
'---------------------------------------------------
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("linecolor")
'vsoItem.Cells("LineColor") = 5
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("linecolor")
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("Fillforegnd")
vsoItem.Cells("Fillforegnd") = plainColor ' WHITE
'MsgBox vsoItem.Characters.Text
'Debug.Print vsoItem.Characters.Text
'MsgBox ApprovedStatus
'MsgBox vsoItem.Cells("Fillforegnd").Name
'Debug.Print ApprovedStatus
'vsoItem.Cells("Fillforegnd") = 6 ' PINK

If Trim(vsoItem.Characters.Text) = "Originator created request" And (ApprovedStatus >= 1) Then
'MsgBox "AAA-1"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Procurement Accessed feasibility" And (ApprovedStatus >= 2) Then
'MsgBox "AAA-2"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Writing RFP" And (ApprovedStatus >= 3) Then
'MsgBox "AAA-3"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Submit to Legal" And (ApprovedStatus >= 4) Then
'MsgBox "AAA-4"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Submit to Publish" And (ApprovedStatus >= 5) Then
'MsgBox "AAA-5"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Analysis & Award" And (ApprovedStatus >= 6) Then
'MsgBox "AAA-6"
vsoItem.Cells("Fillforegnd") = fillColor
End If


'Debug.Print vsoItem.Name; " "; vsoItem.Cells("Fillforegnd")
'---------------------------------------------------
End If
End If
Next
Next
Next
End Sub
 
C

Chris Roth

Are you using Visio 2003?

If the "Web Part" uses the Visio drawing control, then VBA does not
function. I'm not 100% sure if Web Part = Visio Drawing Control, but I do
know tha the Vis control doesn't support VBA macros.

You might also try a simple test - make a document with one or two lines of
test code and load it in WSS.

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
MsgBox "Hello World"
Visio.ActivePage.DrawRectangle( 0,0,5,5 )
End Sub

--

Hope this helps,

Chris Roth
Visio MVP
visioguy @ extremely warm mail.com



PP said:
Hi All

I have a visio diagram, which works sucessfully on my local box, but fails
Click to expand...
inside the Windows Share Point (WSS) web-part.
Here is some information about VISIO doc:
It has 6 shape objects. What I do is, on_load of this visio document, I
Click to expand...
read an XML file (read the value of one of the node), based on this value
the the back-ground color of the SHAPE object is changed.
Note: This XML file gets created by Infopath, so in-reality it shouldn't
Click to expand...
make any different. Correct? :)
On my local machine, the color changes, but within the WSS, it does not work at all.

Can anybody please tell me what could be the issue.
I have the code below for my VISIO.

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
'Declare object variables as Visio object types.
Dim vsoPage As Visio.Page
Dim vsoDocument As Visio.Document
Dim vsoDocuments As Visio.Documents
Dim vsoPages As Visio.Pages
Dim vsoItem As Visio.Shape
Dim vsoItems As Visio.Shapes

'Iterate through all open documents.
Set vsoDocuments = Application.Documents

'----------------------------------------------
Dim plainColor As Integer
Dim fillColor As Integer
plainColor = 1
fillColor = 13 '6 : Pink, 13 : Green
'----------------------------------------------

'----------------------------------------------
Dim vsoStyles As Visio.Styles
Dim vsoStyle As Visio.Style
'----------------------------------------------

'----------------------------------------------
' Read XML file
'----------------------------------------------
Dim xmlDoc, nodes, ApprovedStatus
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = "false"
'xmlDoc.Load ("c:\Request.xml")
xmlDoc.Load ("\\milkyway\i$\Request.xml")
'xmlDoc.Load ("http://proposal5/RFPHome/PDDS/Proposals Forms/request.xml")

Set nodes = xmlDoc.documentElement.childNodes
'MsgBox (nodes.Item(0).Text) ' -- <my:rtbHeader>
'MsgBox (nodes.Item(54).Text) ' -- <my:field54>
ApprovedStatus = CInt(nodes.Item(54).Text)
'----------------------------------------------

For Each vsoDocument In vsoDocuments
'Debug.Print vsoDocument.FullName
'Iterate through all pages in a drawing.
Set vsoPages = vsoDocument.Pages
For Each vsoPage In vsoPages
'MsgBox (vsoPage.Name)
Set vsoItems = vsoPage.Shapes
For Each vsoItem In vsoItems
'MsgBox (vsoItem.Name)
'MsgBox vsoItem.Application
If Len(vsoItem.Name) >= 7 Then
If LCase(Mid(vsoItem.Name, 1, 7)) = "process" Then
'MsgBox vsoItem.Characters.Text
'---------------------------------------------------
' Now filling color in the boxes
'---------------------------------------------------
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("linecolor")
'vsoItem.Cells("LineColor") = 5
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("linecolor")
'Debug.Print vsoItem.Name; " "; vsoItem.Cells("Fillforegnd")
vsoItem.Cells("Fillforegnd") = plainColor ' WHITE
'MsgBox vsoItem.Characters.Text
'Debug.Print vsoItem.Characters.Text
'MsgBox ApprovedStatus
'MsgBox vsoItem.Cells("Fillforegnd").Name
'Debug.Print ApprovedStatus
'vsoItem.Cells("Fillforegnd") = 6 ' PINK

If Trim(vsoItem.Characters.Text) = "Originator
Click to expand...
created request" And (ApprovedStatus >= 1) Then
'MsgBox "AAA-1"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Procurement
Click to expand...
Accessed feasibility" And (ApprovedStatus >= 2) Then
'MsgBox "AAA-2"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Writing RFP" And (ApprovedStatus >= 3) Then
'MsgBox "AAA-3"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Submit to Legal" And (ApprovedStatus >= 4) Then
'MsgBox "AAA-4"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Submit to
Click to expand...
Publish" And (ApprovedStatus >= 5) Then
'MsgBox "AAA-5"
vsoItem.Cells("Fillforegnd") = fillColor
End If
If Trim(vsoItem.Characters.Text) = "Analysis &
Click to expand...
Award" And (ApprovedStatus >= 6) Then
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Background color ENum values 4
list all connections and endpoints 6
Code does not error but no copy either 4
Table Macro Not Working 100% Full Capacity 1
Macro to download house prices from web 0
question re removing final Paragraph mark (and field) from autotex 4
Why does this not stop when I push "yes' or "cancel in the message 14
"Folder does not contain contacts" in Microsoft Outlook 0

Top