Visio Guy

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

Quote from: bendesarts on October 07, 2016, 02:44:58 PMDo 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 !

Thank you for your feedback.

May you move my post to the programming area ?

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) (https://translate.google.com/translate?sl=ru&tl=en&js=y&prev=_t&hl=ru&ie=UTF-8&u=http%3A%2F%2Fwww.cyberforum.ru%2Fms-visio%2Fthread1600113.html&edit-text=&act=url)
Drawing on the points in the file (https://translate.google.com/translate?hl=ru&sl=ru&tl=en&u=http%3A%2F%2Fvisio.getbb.ru%2Fviewtopic.php%3Ff%3D3%26t%3D246)

It's already under programming and code. 

Wapperdude

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 ?

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 :

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

Quote from: bendesarts on October 08, 2016, 07:57:47 AM
--> 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.

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

Quote from: bendesarts on October 07, 2016, 03:13:10 PM
Thank you for your feedback.

May you move my post to the programming area ?

I moved it.

Quote from: bendesarts on October 09, 2016, 07:59:31 PM
Have you some experiences with these codes ?

may be  :)
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

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

Quote from: bendesarts on October 10, 2016, 06:42:38 AMSub 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
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
Set sh = wn.Shape.DrawLine(- 5 / 25.4, 0, xmax + 5 / 25.4, 0) instead
Set sh = wn.Shape.DrawLine(xmin - 5 / 25.4, 0, xmax + 5 / 25.4, 0)

Hello,

Thank you for your feedback.
I insert these lines :

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.

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.

bendesarts,

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

Quote from: Surrogate on October 09, 2016, 11:47:08 PM3. run this macro

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

Surrogate,
If I understand, I should create this code in visual basic but in visio. --> OK
But, after how the excel file containing the xy coordinates of the points is called ?
thank you for your help

Quote from: bendesarts on October 10, 2016, 08:38:33 AM
I should create this code in visual basic but in visio. --> OK

yes, you are rigth. my code for VBA IDE build-in Visio

Quote from: bendesarts on October 10, 2016, 08:38:33 AMBut, after how the excel file containing the xy coordinates of the points is called ?

my code use late binding ! there i define Excel Application and Excel's ActiveWorkbook
Dim ea As Object ' Excel Application
Dim ew As Object ' Excel Workbook
Set ea = GetObject(, "excel.Application")
Set ew = ea.activeworkbook if workbook with xy-coordinates is activeworkbook, my code read these data from 1st sheet of that workbook, from first and second columns !

Quote from: Surrogate on October 09, 2016, 11:47:08 PM2. fill x values in 1st column.  fill y values in 2nd column

no magic, just code !

OK

1) May you help me to put the right code to specify correctly the full directory path to the file and the good sheet in the excel file ?

Here my proposal but the sheet of the excel file is not specified for the moment :

Dim ea As Object ' Excel Application
Dim ew As Object ' Excel Workbook
Set ea = GetObject(c:\[b]windows\test\ExcelFile[/b], "excel.Application")
Set ew = ea.activeworkbook

2) with this code, is the sheet selected the sheet1 by default ?

Thank you for you feedback

Quote from: bendesarts on October 10, 2016, 09:18:40 AMhelp me to put the right code to specify correctly the full directory path

You don't need put directory path to GetObject function, it is Optional argument !

Quote from: MSDNGetObject Function

Quote from: bendesarts on October 10, 2016, 09:18:40 AM2) with this code, is the sheet selected the sheet1 by default ?

Yes.
try this file

Great it works well!
Perfect, thank you for your help