从老外那里找来，做了一些修改，原文地址：http://www.vbaexpress.com/kb/getarticle.php?kb_id=506
OptionExplicitPublicSubLocationTable()’Thisroutinewillcreateatextfileofthelocationandsizeofall2-dshapes’onthecurrentpageDimshpObjAsVisio.Shape,celObjAsVisio.CellDimShpNoAsInteger,TabchrAsString,localCentAsDoubleDimLocationXAsString,LocationYAsStringDimShapeWidthAsString,ShapeHeightAsStringDimunitAsStringunit=”mm”‘OpenorcreatetextfiletowritedataOpen”C:\temp\LocationTable.xml”ForOutputSharedAs#1Tabchr=Chr(9)’TabPrint#1,”<?xmlversion=””1.0″”encoding=””gb2312″”?>”Print#1,”<documentpath=”””;Visio.ActiveDocument.Path;”””name=”””;Visio.ActiveDocument.Name;”””>”Print#1,”<shapesunit=”””;unit;”””>”‘LoopShapescollectionForShpNo=1ToVisio.ActivePage.Shapes.CountSetshpObj=Visio.ActivePage.Shapes(ShpNo)IfNotshpObj.OneDThen’Onlylistthe2-Dshapes’GetlocationShapeSetcelObj=shpObj.Cells(“pinx”)localCent=celObj.Result(unit)LocationX=localCent’Format(localCent,”000.0000″)SetcelObj=shpObj.Cells(“piny”)localCent=celObj.Result(unit)LocationY=Format(localCent,”000.0000″)’GetSizeShapeSetcelObj=shpObj.Cells(“width”)localCent=celObj.Result(unit)ShapeWidth=Format(localCent,”000.0000″)SetcelObj=shpObj.Cells(“height”)localCent=celObj.Result(unit)ShapeHeight=Format(localCent,”0.0000″)’WritevaluestoTextfilestartingNameofShapePrint#1,”<shapename=”””;shpObj.Name;”””type=”””;shpObj.Type;”””text=”””;shpObj.Text;”””bounds=”””;_LocationX;”,”;LocationY;”,”;ShapeWidth;”,”;ShapeHeight;”””/>”EndIfNextShpNoPrint#1,”</shapes>”Print#1,”</document>”‘CloseTextfileClose#1’CleanUpSetcelObj=NothingSetshpObj=NothingEndSub
生活若剥去了理想梦想幻想，那生命便只是一堆空架子
