S
Shad
I would lie to know from a shapes perspective,
1/ for the connections coming to it, which shape they come from (plus the
from shapes uniqueID)
2/ for the connections going from it, which shape they go to (plus the to
shapes uniqueID)
Please see program I wrote which I thought would get me to the above end
result. Unfortunatly, the fromObj.UniqueID & toObj.UniqueID is not correct.
Any suggestion on getting my program to work so that I can related the
unieqID of a shape and the connections to and from and thier associated
uniqueID's would be most appriciated.
Shad
-------------------------------------------------------
Option Explicit
Dim appExcel As Excel.Application 'The Excel application object
Dim xlBook As Excel.Workbook 'The Excel workbook object
Dim xlSheet As Excel.Worksheet 'The Excel spreadsheet object
Dim visApp As Visio.Application 'Visio Application object
Dim visDoc As Visio.Document 'Visio Document object
Dim docsObj As Visio.Documents
Dim docObj As Visio.Document
Dim visStn As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim shpsObj As Visio.Shapes
Dim shpObj As Visio.Shape
Dim stnObj As Visio.Document
Dim vsoRectangle As Visio.Shape
Dim fromObj As Visio.Shape
Dim toObj As Visio.Shape
Dim consObj As Visio.Connects
Dim conObj As Visio.Connect
Dim fromData As Integer
Dim fromStr As String
Dim toData As Integer
Dim toStr As String
Dim inCount1 As Integer
Dim celObjHeight As Visio.Cell
Dim celObjWidth As Visio.Cell
Private Sub Command1_Click()
Set docObj = visApp.ActiveDocument
Debug.Print "docObj", docObj
Set pagsObj = docObj.Pages
Set pagObj = pagsObj.Item(1)
Debug.Print "pagObj", pagObj
'Get the Connects collection for the page
Set consObj = pagObj.Connects
Set shpsObj = pagObj.Shapes
Debug.Print "shpsObj count", shpsObj.Count
Call Pass_To_Excel
End Sub
Private Sub Command2_Click()
'Loop through the FROM Connects collection
For Each conObj In consObj
'Get the From information
Set fromObj = conObj.FromSheet
fromData = conObj.FromPart
'Use fromData to determine the type of connection
fromStr = GetFromString(fromData)
If fromObj.UniqueID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 9).Value = fromData
xlSheet.Cells(row, 10).Value = fromStr
xlSheet.Cells(row, 11).Value = fromObj.UniqueID
End If
Next
'Loop through the TO Connects collection
For Each conObj In consObj
'Get the To information
Set toObj = conObj.ToSheet
toData = conObj.ToPart
'Use toData to determine the type of shape the connector is
connected to
toStr = GetToString(toData)
If toObj.UniqueID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 12).Value = toData
xlSheet.Cells(row, 13).Value = toStr
xlSheet.Cells(row, 14).Value = toObj.UniqueID
End If
Next
End Sub
Private Sub Form_Load()
On Error Resume Next
'Get the open instance of Visio
Set visApp = GetObject(, "Visio.Application")
If (visApp Is Nothing) Then
'There is no open instance of Visio, create one
Set visApp = CreateObject("Visio.Application")
'Add a new blank drawing page
Set visDoc = visApp.Documents.Add("")
Else
'There was an open instance of Visio
If visApp.Documents.Count = 0 Then
'If there are no open documents in this instance of Visio,
'add a new blank drawing
Set visDoc = visApp.Documents.Add("")
Else
'Otherwise, get the currently active document
Set visDoc = visApp.ActiveDocument
End If
End If
'Set visStn = visApp.Documents.Add(App.Path & "\LogicGates.vss")
End Sub
Public Sub Pass_To_Excel()
Dim i As Integer
Dim row As Integer
On Error Resume Next
Set appExcel = CreateObject("Excel.Application")
'Note: unlike Visio, Excel is not visible by default when you create a new
instance.
'The next statements makes Excel visible, create a new workbook and access the
'first worksheet.
appExcel.Application.Visible = True
Set xlBook = appExcel.Workbooks.Add
Set xlSheet = xlBook.Worksheets("Sheet1")
'Note: row keeps track of which row we are writing into in the Excel
spreadsheet.
row = 1
'Note: on the next line, Cells is an Excel object method.
xlSheet.Cells(row, 2).Value = "Obj.Name"
xlSheet.Cells(row, 2).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 3).Value = "PinX"
xlSheet.Cells(row, 3).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 4).Value = "PinY"
xlSheet.Cells(row, 4).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 5).Value = "Width"
xlSheet.Cells(row, 5).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 6).Value = "Height"
xlSheet.Cells(row, 6).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 7).Value = "shpObj.UniqueID"
xlSheet.Cells(row, 7).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 8).Value = "consObj.Count"
xlSheet.Cells(row, 8).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 9).Value = "fromData"
xlSheet.Cells(row, 9).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 10).Value = "fromStr"
xlSheet.Cells(row, 10).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 11).Value = "fromObj.Name"
xlSheet.Cells(row, 11).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 12).Value = "toData"
xlSheet.Cells(row, 12).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 13).Value = "toStr"
xlSheet.Cells(row, 13).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 14).Value = "toObj.Name"
xlSheet.Cells(row, 14).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 15).Value = "Prop.Row_1.value"
xlSheet.Cells(row, 15).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 16).Value = "Prop.Row_2.value"
xlSheet.Cells(row, 16).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 17).Value = "Prop.Row_3.value"
xlSheet.Cells(row, 17).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 18).Value = "Prop.Row_4.value"
xlSheet.Cells(row, 18).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 19).Value = "Prop.Row_5.value"
xlSheet.Cells(row, 19).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 20).Value = "Prop.Row_6.value"
xlSheet.Cells(row, 20).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 21).Value = "Prop.Row_7.value"
xlSheet.Cells(row, 21).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 22).Value = "Prop.Row_8.value"
xlSheet.Cells(row, 22).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 23).Value = "Prop.Row_9.value"
xlSheet.Cells(row, 23).HorizontalAlignment = xlCenter
row = row + 1
For i = 1 To shpsObj.Count
Set shpObj = shpsObj(i)
Debug.Print "shpObj.Name", shpObj.Name
xlSheet.Cells(row, 2).Value = shpObj.Name
Debug.Print "shpObj.Pin X", shpObj.Cells("PinX")
xlSheet.Cells(row, 3).Value = shpObj.Cells("PinX")
Debug.Print "shpObj.Pin Y", shpObj.Cells("PinY")
xlSheet.Cells(row, 4).Value = shpObj.Cells("PinY")
Debug.Print "shpObj.Width", shpObj.Cells("Width").Result(visMillimeters)
xlSheet.Cells(row, 5).Value = shpObj.Cells("Width").Result(visMillimeters)
Debug.Print "shpObj.Height", shpObj.Cells("Height").Result(visMillimeters)
xlSheet.Cells(row, 6).Value = shpObj.Cells("Height").Result(visMillimeters)
Debug.Print "shpObj.UniqueID", shpObj.UniqueID(visGetOrMakeGUID)
xlSheet.Cells(row, 7).Value = shpObj.UniqueID(visGetOrMakeGUID)
Debug.Print "consObj.Count", consObj.Count
xlSheet.Cells(row, 8).Value = consObj.Count
'Loop through the FROM Connects collection
For Each conObj In consObj
'Get the From information
Set fromObj = conObj.FromSheet
fromData = conObj.FromPart
'Use fromData to determine the type of connection
fromStr = GetFromString(fromData)
If fromObj.NameID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 9).Value = fromData
xlSheet.Cells(row, 10).Value = fromStr
xlSheet.Cells(row, 11).Value = fromObj.Name
End If
Next
'Loop through the TO Connects collection
For Each conObj In consObj
'Get the To information
Set toObj = conObj.ToSheet
toData = conObj.ToPart
'Use toData to determine the type of shape the connector is
connected to
toStr = GetToString(toData)
If toObj.NameID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 12).Value = toData
xlSheet.Cells(row, 13).Value = toStr
xlSheet.Cells(row, 14).Value = toObj.Name
End If
Next
Debug.Print "Prop.Row_1.value", shpObj.Cells("Prop.Row_1.value").Formula
xlSheet.Cells(row, 15).Value = shpObj.Cells("Prop.Row_1.value").Formula
Debug.Print "Prop.Row_2.value", shpObj.Cells("Prop.Row_2.value").Formula
xlSheet.Cells(row, 16).Value = shpObj.Cells("Prop.Row_2.value").Formula
Debug.Print "Prop.Row_3.value", shpObj.Cells("Prop.Row_3.value").Formula
xlSheet.Cells(row, 17).Value = shpObj.Cells("Prop.Row_3.value").Formula
Debug.Print "Prop.Row_4.value", shpObj.Cells("Prop.Row_4.value").Formula
xlSheet.Cells(row, 18).Value = shpObj.Cells("Prop.Row_4.value").Formula
Debug.Print "Prop.Row_5.value", shpObj.Cells("Prop.Row_5.value").Formula
xlSheet.Cells(row, 19).Value = shpObj.Cells("Prop.Row_5.value").Formula
Debug.Print "Prop.Row_6.value", shpObj.Cells("Prop.Row_6.value").Formula
xlSheet.Cells(row, 20).Value = shpObj.Cells("Prop.Row_6.value").Formula
Debug.Print "Prop.Row_7.value", shpObj.Cells("Prop.Row_7.value").Formula
xlSheet.Cells(row, 21).Value = shpObj.Cells("Prop.Row_7.value").Formula
Debug.Print "Prop.Row_8.value", shpObj.Cells("Prop.Row_8.value").Formula
xlSheet.Cells(row, 22).Value = shpObj.Cells("Prop.Row_8.value").Formula
Debug.Print "Prop.Row_9.value", shpObj.Cells("Prop.Row_9.value").Formula
xlSheet.Cells(row, 23).Value = shpObj.Cells("Prop.Row_9.value").Formula
row = row + 1
Next i
End Sub
Private Function GetFromString(iFromData As Integer) As String
'Convert constants to strings for all
'of the known visFromParts constants
Dim visFromData As VisFromParts
Dim szRetVal As String
On Error GoTo eHandler
visFromData = iFromData
Select Case visFromData
Case Is = VisFromParts.visBegin
szRetVal = "visBegin"
Case Is = VisFromParts.visBeginX
szRetVal = "visBeginX"
Case Is = VisFromParts.visBeginY
szRetVal = "visBeginY"
Case Is = VisFromParts.visBottomEdge
szRetVal = "visBottomEdge"
Case Is = VisFromParts.visCenterEdge
szRetVal = "visCenterEdge"
Case Is = VisFromParts.visConnectFromError
szRetVal = "visConnectFromError"
Case Is = VisFromParts.visControlPoint
szRetVal = "visControlPoint"
Case Is = VisFromParts.visEnd
szRetVal = "visEnd"
Case Is = VisFromParts.visEndX
szRetVal = "visEndX"
Case Is = VisFromParts.visEndY
szRetVal = "visEndY"
Case Is = VisFromParts.visFromAngle
szRetVal = "visFromAngle"
Case Is = VisFromParts.visFromNone
szRetVal = "visFromNone"
Case Is = VisFromParts.visFromPin
szRetVal = "visFromPin"
Case Is = VisFromParts.visLeftEdge
szRetVal = "visLeftEdge"
Case Is = VisFromParts.visMiddleEdge
szRetVal = "visMiddleEdge"
Case Is = VisFromParts.visRightEdge
szRetVal = "visRightEdge"
Case Is = VisFromParts.visTopEdge
szRetVal = "visTopEdge"
Case Else
szRetVal = "Unhandled Case"
End Select
GetFromString = szRetVal
Exit Function
eHandler:
GetFromString = "From Error"
End Function
Private Function GetToString(iToData As Integer) As String
'Convert constant to string for all of
'the known visToParts constants
Dim visToData As VisToParts
Dim szRetVal As String
On Error GoTo eHandler
visToData = iToData
Select Case visToData
Case Is = VisToParts.visConnectToError
szRetVal = "visConnectToError"
Case Is = VisToParts.visGuideIntersect
szRetVal = "visGuideIntersect"
Case Is = VisToParts.visGuideX
szRetVal = "visGuideX"
Case Is = VisToParts.visGuideY
szRetVal = "visGuideY"
Case Is = VisToParts.visToAngle
szRetVal = "visToAngle"
Case Is = VisToParts.visToNone
szRetVal = "visToNone"
Case Is = VisToParts.visWholeShape
szRetVal = "visWholeShape"
Case Is >= VisToParts.visConnectionPoint
szRetVal = "visConnectionPoint" & CStr(visToData -
visConnectionPoint + 1)
Case Else
szRetVal = "Unhandled Case"
End Select
GetToString = szRetVal
Exit Function
eHandler:
GetToString = "To Error"
End Function
1/ for the connections coming to it, which shape they come from (plus the
from shapes uniqueID)
2/ for the connections going from it, which shape they go to (plus the to
shapes uniqueID)
Please see program I wrote which I thought would get me to the above end
result. Unfortunatly, the fromObj.UniqueID & toObj.UniqueID is not correct.
Any suggestion on getting my program to work so that I can related the
unieqID of a shape and the connections to and from and thier associated
uniqueID's would be most appriciated.
Shad
-------------------------------------------------------
Option Explicit
Dim appExcel As Excel.Application 'The Excel application object
Dim xlBook As Excel.Workbook 'The Excel workbook object
Dim xlSheet As Excel.Worksheet 'The Excel spreadsheet object
Dim visApp As Visio.Application 'Visio Application object
Dim visDoc As Visio.Document 'Visio Document object
Dim docsObj As Visio.Documents
Dim docObj As Visio.Document
Dim visStn As Visio.Document
Dim pagsObj As Visio.Pages
Dim pagObj As Visio.Page
Dim shpsObj As Visio.Shapes
Dim shpObj As Visio.Shape
Dim stnObj As Visio.Document
Dim vsoRectangle As Visio.Shape
Dim fromObj As Visio.Shape
Dim toObj As Visio.Shape
Dim consObj As Visio.Connects
Dim conObj As Visio.Connect
Dim fromData As Integer
Dim fromStr As String
Dim toData As Integer
Dim toStr As String
Dim inCount1 As Integer
Dim celObjHeight As Visio.Cell
Dim celObjWidth As Visio.Cell
Private Sub Command1_Click()
Set docObj = visApp.ActiveDocument
Debug.Print "docObj", docObj
Set pagsObj = docObj.Pages
Set pagObj = pagsObj.Item(1)
Debug.Print "pagObj", pagObj
'Get the Connects collection for the page
Set consObj = pagObj.Connects
Set shpsObj = pagObj.Shapes
Debug.Print "shpsObj count", shpsObj.Count
Call Pass_To_Excel
End Sub
Private Sub Command2_Click()
'Loop through the FROM Connects collection
For Each conObj In consObj
'Get the From information
Set fromObj = conObj.FromSheet
fromData = conObj.FromPart
'Use fromData to determine the type of connection
fromStr = GetFromString(fromData)
If fromObj.UniqueID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 9).Value = fromData
xlSheet.Cells(row, 10).Value = fromStr
xlSheet.Cells(row, 11).Value = fromObj.UniqueID
End If
Next
'Loop through the TO Connects collection
For Each conObj In consObj
'Get the To information
Set toObj = conObj.ToSheet
toData = conObj.ToPart
'Use toData to determine the type of shape the connector is
connected to
toStr = GetToString(toData)
If toObj.UniqueID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 12).Value = toData
xlSheet.Cells(row, 13).Value = toStr
xlSheet.Cells(row, 14).Value = toObj.UniqueID
End If
Next
End Sub
Private Sub Form_Load()
On Error Resume Next
'Get the open instance of Visio
Set visApp = GetObject(, "Visio.Application")
If (visApp Is Nothing) Then
'There is no open instance of Visio, create one
Set visApp = CreateObject("Visio.Application")
'Add a new blank drawing page
Set visDoc = visApp.Documents.Add("")
Else
'There was an open instance of Visio
If visApp.Documents.Count = 0 Then
'If there are no open documents in this instance of Visio,
'add a new blank drawing
Set visDoc = visApp.Documents.Add("")
Else
'Otherwise, get the currently active document
Set visDoc = visApp.ActiveDocument
End If
End If
'Set visStn = visApp.Documents.Add(App.Path & "\LogicGates.vss")
End Sub
Public Sub Pass_To_Excel()
Dim i As Integer
Dim row As Integer
On Error Resume Next
Set appExcel = CreateObject("Excel.Application")
'Note: unlike Visio, Excel is not visible by default when you create a new
instance.
'The next statements makes Excel visible, create a new workbook and access the
'first worksheet.
appExcel.Application.Visible = True
Set xlBook = appExcel.Workbooks.Add
Set xlSheet = xlBook.Worksheets("Sheet1")
'Note: row keeps track of which row we are writing into in the Excel
spreadsheet.
row = 1
'Note: on the next line, Cells is an Excel object method.
xlSheet.Cells(row, 2).Value = "Obj.Name"
xlSheet.Cells(row, 2).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 3).Value = "PinX"
xlSheet.Cells(row, 3).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 4).Value = "PinY"
xlSheet.Cells(row, 4).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 5).Value = "Width"
xlSheet.Cells(row, 5).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 6).Value = "Height"
xlSheet.Cells(row, 6).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 7).Value = "shpObj.UniqueID"
xlSheet.Cells(row, 7).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 8).Value = "consObj.Count"
xlSheet.Cells(row, 8).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 9).Value = "fromData"
xlSheet.Cells(row, 9).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 10).Value = "fromStr"
xlSheet.Cells(row, 10).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 11).Value = "fromObj.Name"
xlSheet.Cells(row, 11).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 12).Value = "toData"
xlSheet.Cells(row, 12).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 13).Value = "toStr"
xlSheet.Cells(row, 13).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 14).Value = "toObj.Name"
xlSheet.Cells(row, 14).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 15).Value = "Prop.Row_1.value"
xlSheet.Cells(row, 15).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 16).Value = "Prop.Row_2.value"
xlSheet.Cells(row, 16).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 17).Value = "Prop.Row_3.value"
xlSheet.Cells(row, 17).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 18).Value = "Prop.Row_4.value"
xlSheet.Cells(row, 18).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 19).Value = "Prop.Row_5.value"
xlSheet.Cells(row, 19).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 20).Value = "Prop.Row_6.value"
xlSheet.Cells(row, 20).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 21).Value = "Prop.Row_7.value"
xlSheet.Cells(row, 21).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 22).Value = "Prop.Row_8.value"
xlSheet.Cells(row, 22).HorizontalAlignment = xlCenter
xlSheet.Cells(row, 23).Value = "Prop.Row_9.value"
xlSheet.Cells(row, 23).HorizontalAlignment = xlCenter
row = row + 1
For i = 1 To shpsObj.Count
Set shpObj = shpsObj(i)
Debug.Print "shpObj.Name", shpObj.Name
xlSheet.Cells(row, 2).Value = shpObj.Name
Debug.Print "shpObj.Pin X", shpObj.Cells("PinX")
xlSheet.Cells(row, 3).Value = shpObj.Cells("PinX")
Debug.Print "shpObj.Pin Y", shpObj.Cells("PinY")
xlSheet.Cells(row, 4).Value = shpObj.Cells("PinY")
Debug.Print "shpObj.Width", shpObj.Cells("Width").Result(visMillimeters)
xlSheet.Cells(row, 5).Value = shpObj.Cells("Width").Result(visMillimeters)
Debug.Print "shpObj.Height", shpObj.Cells("Height").Result(visMillimeters)
xlSheet.Cells(row, 6).Value = shpObj.Cells("Height").Result(visMillimeters)
Debug.Print "shpObj.UniqueID", shpObj.UniqueID(visGetOrMakeGUID)
xlSheet.Cells(row, 7).Value = shpObj.UniqueID(visGetOrMakeGUID)
Debug.Print "consObj.Count", consObj.Count
xlSheet.Cells(row, 8).Value = consObj.Count
'Loop through the FROM Connects collection
For Each conObj In consObj
'Get the From information
Set fromObj = conObj.FromSheet
fromData = conObj.FromPart
'Use fromData to determine the type of connection
fromStr = GetFromString(fromData)
If fromObj.NameID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 9).Value = fromData
xlSheet.Cells(row, 10).Value = fromStr
xlSheet.Cells(row, 11).Value = fromObj.Name
End If
Next
'Loop through the TO Connects collection
For Each conObj In consObj
'Get the To information
Set toObj = conObj.ToSheet
toData = conObj.ToPart
'Use toData to determine the type of shape the connector is
connected to
toStr = GetToString(toData)
If toObj.NameID = shpObj.UniqueID(visGetOrMakeGUID) Then
xlSheet.Cells(row, 12).Value = toData
xlSheet.Cells(row, 13).Value = toStr
xlSheet.Cells(row, 14).Value = toObj.Name
End If
Next
Debug.Print "Prop.Row_1.value", shpObj.Cells("Prop.Row_1.value").Formula
xlSheet.Cells(row, 15).Value = shpObj.Cells("Prop.Row_1.value").Formula
Debug.Print "Prop.Row_2.value", shpObj.Cells("Prop.Row_2.value").Formula
xlSheet.Cells(row, 16).Value = shpObj.Cells("Prop.Row_2.value").Formula
Debug.Print "Prop.Row_3.value", shpObj.Cells("Prop.Row_3.value").Formula
xlSheet.Cells(row, 17).Value = shpObj.Cells("Prop.Row_3.value").Formula
Debug.Print "Prop.Row_4.value", shpObj.Cells("Prop.Row_4.value").Formula
xlSheet.Cells(row, 18).Value = shpObj.Cells("Prop.Row_4.value").Formula
Debug.Print "Prop.Row_5.value", shpObj.Cells("Prop.Row_5.value").Formula
xlSheet.Cells(row, 19).Value = shpObj.Cells("Prop.Row_5.value").Formula
Debug.Print "Prop.Row_6.value", shpObj.Cells("Prop.Row_6.value").Formula
xlSheet.Cells(row, 20).Value = shpObj.Cells("Prop.Row_6.value").Formula
Debug.Print "Prop.Row_7.value", shpObj.Cells("Prop.Row_7.value").Formula
xlSheet.Cells(row, 21).Value = shpObj.Cells("Prop.Row_7.value").Formula
Debug.Print "Prop.Row_8.value", shpObj.Cells("Prop.Row_8.value").Formula
xlSheet.Cells(row, 22).Value = shpObj.Cells("Prop.Row_8.value").Formula
Debug.Print "Prop.Row_9.value", shpObj.Cells("Prop.Row_9.value").Formula
xlSheet.Cells(row, 23).Value = shpObj.Cells("Prop.Row_9.value").Formula
row = row + 1
Next i
End Sub
Private Function GetFromString(iFromData As Integer) As String
'Convert constants to strings for all
'of the known visFromParts constants
Dim visFromData As VisFromParts
Dim szRetVal As String
On Error GoTo eHandler
visFromData = iFromData
Select Case visFromData
Case Is = VisFromParts.visBegin
szRetVal = "visBegin"
Case Is = VisFromParts.visBeginX
szRetVal = "visBeginX"
Case Is = VisFromParts.visBeginY
szRetVal = "visBeginY"
Case Is = VisFromParts.visBottomEdge
szRetVal = "visBottomEdge"
Case Is = VisFromParts.visCenterEdge
szRetVal = "visCenterEdge"
Case Is = VisFromParts.visConnectFromError
szRetVal = "visConnectFromError"
Case Is = VisFromParts.visControlPoint
szRetVal = "visControlPoint"
Case Is = VisFromParts.visEnd
szRetVal = "visEnd"
Case Is = VisFromParts.visEndX
szRetVal = "visEndX"
Case Is = VisFromParts.visEndY
szRetVal = "visEndY"
Case Is = VisFromParts.visFromAngle
szRetVal = "visFromAngle"
Case Is = VisFromParts.visFromNone
szRetVal = "visFromNone"
Case Is = VisFromParts.visFromPin
szRetVal = "visFromPin"
Case Is = VisFromParts.visLeftEdge
szRetVal = "visLeftEdge"
Case Is = VisFromParts.visMiddleEdge
szRetVal = "visMiddleEdge"
Case Is = VisFromParts.visRightEdge
szRetVal = "visRightEdge"
Case Is = VisFromParts.visTopEdge
szRetVal = "visTopEdge"
Case Else
szRetVal = "Unhandled Case"
End Select
GetFromString = szRetVal
Exit Function
eHandler:
GetFromString = "From Error"
End Function
Private Function GetToString(iToData As Integer) As String
'Convert constant to string for all of
'the known visToParts constants
Dim visToData As VisToParts
Dim szRetVal As String
On Error GoTo eHandler
visToData = iToData
Select Case visToData
Case Is = VisToParts.visConnectToError
szRetVal = "visConnectToError"
Case Is = VisToParts.visGuideIntersect
szRetVal = "visGuideIntersect"
Case Is = VisToParts.visGuideX
szRetVal = "visGuideX"
Case Is = VisToParts.visGuideY
szRetVal = "visGuideY"
Case Is = VisToParts.visToAngle
szRetVal = "visToAngle"
Case Is = VisToParts.visToNone
szRetVal = "visToNone"
Case Is = VisToParts.visWholeShape
szRetVal = "visWholeShape"
Case Is >= VisToParts.visConnectionPoint
szRetVal = "visConnectionPoint" & CStr(visToData -
visConnectionPoint + 1)
Case Else
szRetVal = "Unhandled Case"
End Select
GetToString = szRetVal
Exit Function
eHandler:
GetToString = "To Error"
End Function