Visio Guy

Hi there,

I'm visio and excell 2003. My problem is that I need to link data from excel to visio to create a drawing, that has different shapes dependent on the excel data.

My spreadsheet has 3 columns: Component, ID Code, Cost.
When I import the data I want visio to create previously specified shapes depending on the value in the  'component' column. The shapes also need to have the information from each of the other rows too.

For example, if the row 'component' has the following values: box, box, box, circle, box, triangle. I want visio to make 4 boxes, 1 circle and 1 triangle, each with their own linked data.

To me it seems very simple, but I can't figure out how to do the multiple shapes.

Thanks a lot in advance for any advice you have to offer :)  :)

PS: I am not worried about the placement or connections of shapes, as it is likely that I will need to rearrange them manually anyway

this macro for fixed table as you describe: 3 columns and 6 rows. like as
box   1   100
box   1   100
box   1   100
circle   2   150
box   1   100
triangle   3   500

Sub ololo()
Dim r As Integer
Dim c As Integer
Dim x As Integer
' in this section you choose excel file
Dim oExcel As Excel.Application
Set oExcel = CreateObject("Excel.Application")
Dim sp As Excel.Workbook
Dim ffs As FileDialogFilters
Dim sFileName As String
oExcel.Visible = True
Dim fd As FileDialog
Set fd = oExcel.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = False
.InitialFileName = pth
Set ffs = .Filters
    With ffs
        .Clear
        .Add "Excel", "*.xls*"
    End With
oExcel.FileDialog(msoFileDialogOpen).Show
End With
sFileName = oExcel.FileDialog(msoFileDialogOpen).SelectedItems(1)
Set sp = oExcel.Workbooks.Open(sFileName)
sp.Activate
' there is macro get data from excel range
  ReDim arr(1 To 6, 1 To 3) As Variant ' arr is array there placed data from excel range
  For r = 1 To 6
  For c = 1 To 3
  arr(r, c) = sp.Worksheets(1).Cells(r, c) ' iterate cells in excel range
  Next
  Next
sp.Close SaveChanges:=False ' close excel file without save
oExcel.Application.Quit ' quit excel application
' there is shapes placed and set text
For x = 1 To 6
If arr(x, 1) = "box" Then Application.ActiveWindow.Page.Drop Application.Documents.Item("BASIC_M.VSS").Masters.ItemU("Square"), x * 2, 5 ' drop master "box"
If arr(x, 1) = "circle" Then Application.ActiveWindow.Page.Drop Application.Documents.Item("BASIC_M.VSS").Masters.ItemU("Circle"), x * 2, 5 ' drop master "circle"
If arr(x, 1) = "triangle" Then Application.ActiveWindow.Page.Drop Application.Documents.Item("BASIC_M.VSS").Masters.ItemU("Triangle"), x * 2, 5 ' drop master "triangle"
Set shp = ActiveWindow.Selection.Item(1)
shp.Characters = arr(x, 1) & Chr(10) & arr(x, 2) & Chr(10) & arr(x, 3) '
Next x
MsgBox "TheEnd"
End Sub