Plot points from an import of xy absolute coordinates in a excel file

[bendesarts]

Hello,

I have a excel file containing the list of points with xy absolute coordinates (attached in this post).

I would like to plot with a systematic process these points in visio. For these points, I would like also to define a new axis system with a specific graduation.

I attach also a visio file to show you what I would like to obtain. It consists of points plotted thanks to the use of excel file and in a new defined frame.

1) Do you have ideas so as to draw these points automatically from a list of coordinates in a excel file ?

2) How can I define a axis system with a new graduation ? The points should be plotted in this frame with a new graduation and not with the paper dimension.

Thanks a lot for your help

[Surrogate]

Do you have ideas so as to draw these points automatically from a list of coordinates in a excel file ?

You must write code for it. General Visio haven't that feature !

[bendesarts]

Thank you for your feedback.

May you move my post to the programming area ?

[Surrogate]

No, i can't move this topic! Because i'm not moderator or admin there

Look at two same russian-speaking topics (via google-translate service)
Construction of the line \ points by coordinates (latitude \ longitude)
Drawing on the points in the file

[wapperdude]

It's already under programming and code. 

Wapperdude

[bendesarts]

Hello Surrogate,

Thank you for your help.
May you help me to find properly the code that I need and be clear on the method that I should conduct ?

1) About the codes

there are 2 codes :

Code for plotting the points defined by xy coordinates
--> what is these strange letters in the lines 3 and 4 ?

Code Select Expand

Sub FirstPart ()
Dim shp As Shape
Dim x (1 To 5) As Integer 'êîîðäèíàòû Õ ëèíèè
Dim y (1 To 5) As Integer 'êîîðäèíàòû Y ëèíèè
x (1) = 0
x (2) = 1
x (3) = 1
x (4) = 0
y (1) = 0
y (2) = 0
y (3) = 2
y (4) = 2
Application.ActiveWindow.Page.DrawLine x (1), y (1), x (2), y (2)
Set shp = ActiveWindow.Selection.Item (1)
For i = 2 To 4 step 2
shp.DrawLine x (i), y (i), x (i + 1), y (i + 1)
Next i
End Sub

Code to draw the lines :

Code Select Expand

Public Sub DrawPolyline_Example ()

Dim vsoShape As Visio.Shape
Dim adblXYPoints (1 To 8) As Double
Dim intCounter As Integer

'Initialize array with coordinates.
  adblXYPoints (1) = 1
adblXYPoints (2) = 1
adblXYPoints (3) = 3
adblXYPoints (4) = 3
adblXYPoints (5) = 5
adblXYPoints (6) = 1
adblXYPoints (7) = 1
adblXYPoints (8) = 2

'Use the DrawPolyline method to draw a shape that has 2-D behavior.
  Set vsoShape = ActivePage.DrawPolyline (adblXYPoints, 0)

'Increase the Y-coordinate of the array by 4 to separate
  'the next shape drawn from the first .
  For intCounter = 2 To UBound (adblXYPoints) Step 2
adblXYPoints (intCounter) = adblXYPoints (intCounter) + 4
Next intCounter

'Use the DrawPolyline method to draw a shape that has 1-D behavior.
  Set vsoShape = ActivePage.DrawPolyline (adblXYPoints, visPolyline1D )

End Sub

2) About the methods

What are the steps that I have to conducted ?

Here my proposal.

a) from the excel sheet where I have my points with xy coordinates, i launch these macros from vb
b) normally the points should arrive on visio... I think I dreaming a bit...

Thanks a lot for you help and feedback

[Surrogate]

--> what is these strange letters in the lines 3 and 4 ?

it is russian comments for this code. i just copy code in vba-editor and paste to this post.

[bendesarts]

Have you some experiences with these codes ?

If yes, would you be able to help me to use them ?

Thanks a lot for your help

[Paul Herber]

Thank you for your feedback.

May you move my post to the programming area ?

I moved it.

[Surrogate]

Have you some experiences with these codes ?

may be 

Code Select Expand

Sub test()
Dim w As Shape, wn As Window
Set w = Application.ActiveWindow.Page.DrawRectangle(0, 0, 0, 0)
w.Cells("Geometry1.nofill") = True
w.Cells("Geometry1.noline") = True
w.CellsSRC(visSectionObject, visRowLine, visLineEndArrow).FormulaU = "2"
w.ConvertToGroup
Set wn = w.OpenDrawWindow
Dim ea As Object
Dim ew As Object
Dim x() As Double 
Dim y() As Double
Set ea = GetObject(, "excel.Application")
Set ew = ea.activeworkbook
Dim rc As Integer
rc = ew.sheets(1).usedrange.rows.Count
Dim shp As Shape
ReDim x(2 * rc)
ReDim y(2 * rc)
For i = 1 To rc
x(i) = ew.sheets(1).Cells(i, 1)
y(i) = ew.sheets(1).Cells(i, 2)
Next
Dim xr As Object, yr As Object
Set xr = ew.sheets(1).Range("A1:A" & rc)
Set yr = ew.sheets(1).Range("B1:B" & rc)
xmax = ea.WorksheetFunction.Max(xr)
xmin = ea.WorksheetFunction.Min(xr)
ymax = ea.WorksheetFunction.Max(yr)
ymin = ea.WorksheetFunction.Min(yr)
For i = 1 To rc - 1
wn.Shape.DrawLine x(i), y(i), x(i + 1), y(i + 1)
Next i
Dim sh As Shape
Set sh = wn.Shape.DrawLine(- 5 / 25.4, 0, xmax + 5 / 25.4, 0)
en sh
Set sh = wn.Shape.DrawLine(0, -5 / 25.4, 0, ymax + 5 / 25.4)
en sh
wn.Close
ActiveWindow.Selection.UpdateAlignmentBox
End Sub
1. open excel workbook, sheet 1
2. fill x values in 1st column.  fill y values in 2nd column
3. run this macro

[bendesarts]

Thanks a lot for your help.

1) I open visual basic inside Excel and I create a module called test.
2) I copy/ paste your code for this module.
3) I launch the macro test

But I received the following error message : Sub or Function non defined (as you can see in the file attached)

I probably do a bad manipulation.

Have you some ideas what I'm doing wrong?

Thank you for your help

[Surrogate]

Sub or Function non defined (as you can see in the file attached)

sorry, i forgot paste sub routine named en !
add this code under sub routine named test

Code Select Expand

Sub en(ln As Shape)
ln.CellsSRC(visSectionObject, visRowLine, visLineEndArrow).FormulaU = "2"
End Sub
and run macro again.

this code very simple without scaling and etc. in my tests i use xy coordinates in range [0;5]

also use line

Code Select Expand

Set sh = wn.Shape.DrawLine(- 5 / 25.4, 0, xmax + 5 / 25.4, 0) instead

Code Select Expand

Set sh = wn.Shape.DrawLine(xmin - 5 / 25.4, 0, xmax + 5 / 25.4, 0)

[bendesarts]

Hello,

Thank you for your feedback.
I insert these lines :

Code Select Expand

Sub en(ln As Shape)
ln.CellsSRC(visSectionObject, visRowLine, visLineEndArrow).FormulaU = "2"
End Sub

I have now the following error messages attached with this post.

Do you have other ideas to troubleshoot it?

thank you for your help.

[Yacine]

sorry for joining the discussion so late.
We had a similar topic here: http://visguy.com/vgforum/index.php?topic=942.0
I didn't use VBA, just polylines in shapesheet technique.
Rgds,
Y.

[Surrogate]

bendesarts,

You paste this code to Excel's VBA IDE ! My code for run under Visio

3. run this macro

it is my mistake, i don't write where this code must be pasted