vba - Read Cell properties in Visio using vb -
i trying create vb macro in visio can read info , properties of shape. have rectangle shpae in visio cells name, description, type, size.... , on.
when seek read cells , values getting first cell , value. here code . appreciate help here.
sub testing() dim excelobj object dim excelfile string dim sheetname string ' dim excelbook excel.workbook ' set excelfile = "c:\users\hbhasin\documents\test.xls" 'set sheetname = "new sheet name" set excelobj = createobject("excel.application") excelobj.workbooks.add dim pagobj visio.page dim shpsobj visio.shapes dim shapes visio.shapes dim shpobj visio.shape dim cellobj visio.cell dim storage() string dim ishapecount integer dim integer dim j integer set pagobj = activepage set shpsobj = pagobj.shapes ishapecount = shpsobj.count debug.print ishapecount redim storage(8, ishapecount - 1) = 1 ishapecount - 1 set shpobj = shpsobj(i) storage(1, - 1) = shpobj.name if shpobj.cellexists("prop.name", visexistslocally) set cellobj = shpobj.cellsu("prop.name") storage(2, - 1) = cellobj.resultstr("") end if if shpobj.cellexists("prop.description", visexistslocally) debug.print "test if statement" set cellobj = shpobj.cellsu("prop.description") storage(3, - 1) = cellobj.resultstr("") end if next = 0 ishapecount - 1 debug.print "name- " & storage(0, i) debug.print "description-" & storage(1, i) next end sub in fact, have set debug statement within sec if clause , not execute tells me compiler not seeing sec cell or cell after.
if you're not getting description shape info maybe it's not local, inherited master. here's slight modification of code (with excel part removed don't think it's relevant here):
sub testing() dim shpsobj visio.shapes set shpsobj = activepage.shapes dim ishapecount integer ishapecount = shpsobj.count 'assumes want array of shape info dim storage() string redim storage(ishapecount - 1, 2) 'visio shapes 1 based utilize total count dim integer dim shpobj visio.shape = 1 ishapecount set shpobj = shpsobj(i) storage(i - 1, 0) = shpobj.name 'do want nameu? 'assumes don't care whether cell local or inherited if shpobj.cellexistsu("prop.name", visexistsanywhere) storage(i - 1, 1) = shpobj.cellsu("prop.name").resultstr("") end if if shpobj.cellexistsu("prop.description", visexistsanywhere) storage(i - 1, 2) = shpobj.cellsu("prop.description").resultstr("") end if next dim j long j = lbound(storage, 1) ubound(storage, 1) debug.print "shape name- " & storage(j, 0) debug.print " prop.name- " & storage(j, 1) debug.print " prop.description- " & storage(j, 2) next j end sub if you're running through shapes on page, might want @ each shp in shapes alternative. check out page more details:
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
also, might want seek @ createselection page method narrow downwards target shapes if you're dealing big number
vba visio
No comments:
Post a Comment