Automate Drop & Custom Property from Excel

Started by damswil, September 10, 2015, 05:11:23 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

damswil

Ok so here is my problem: I have a stencil with custom shapes in it, & the shapes have their own custom properties. I also have an excel sheet with 2 columns of data. Column 1 is the name of the shape & column 2 is the description. I  have excel dropping different shapes onto a visio drawing based on what the names are in column 1. However, I can't seem to get it to import the description (column 2) into the custom property of the last shape that is dropped. Anyone have any ideas?

Thanks

Surrogate

i think it will something like that
Sub damswil()
' declare variable excel.application
Dim ea As Object
' declare variable excel.workbook
Dim ew As Object
' declare variable filename
Dim fn As String
' declare variable active shape
Dim sh As Shape
' declare variable row counter
Dim r As Integer
' there is your source workbook
fn = "c:\1\damswil.xlsx"
' create new example of excel application
Set ea = CreateObject("Excel.Application")
' set excel application visible
ea.Visible = True
' open your source workbook
Set ew = ea.workbooks.Open(fn)
For r = 2 To 11 ' iterate 10 rows
' drop shape
Set sh = ActivePage.Drop(Application.Documents.Item("BLOCK_M.VSS").Masters.ItemU("Box"), r * 2, 1)
' rename shape by name from column 1
sh.Name = ew.sheets(1).Cells(r, 1)
' check is shape have shapedata section, if haven't then add this section
If Not (sh.SectionExists(visSectionProp, visExistsAnywhere)) Then sh.AddSection visSectionProp
' check is shape have shapedata cell named "Descr", if haven't then add this cell
If Not (sh.CellExists("Prop.Descr", visExistsAnywhere)) Then sh.AddNamedRow visSectionProp, "Descr", True
' fill shapedata by description from column 2
sh.Cells("Prop.Descr").Formula = Chr(34) & ew.sheets(1).Cells(r, 1) & Chr(34)
Next
' close workbook without save
ew.Close , savechanges:=False
' release ew variable
Set ew = Nothing
' close excel application
ea.Quit
' release ew variable
Set ea = Nothing
End Sub

damswil

Thanks for the response. I was actually going the other way with it, running the code from excel & opening up a Visio drawing. But your's put me on a path that I think is going to work out better for me. Thanks again.