View Single Post
 
Old 04-01-2019, 08:17 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Yes, I can see that would be a very slow way to do things.

I haven't tried to do this before and it may be that you need to create a macro to read the excel data table and create all the shape properties at least for one shape. Once this is done, you could use the same macro or maybe use Shape Data Sets to copy the properties from one shape to another.

Below is a sample macro where I supply a list of field names and add each one as a property to the selected shape on the page.
Code:
Sub AddPropertiesToAShape()
  Dim arrFields() As String, i As Integer, aShp As Shape, iRow As Integer, sVal As String
  Dim sel As Visio.Selection
  Set sel = ActiveWindow.Selection
  arrFields = Split("Field1,Field2,Field3,Field4", ",")
  
  For i = LBound(arrFields) To UBound(arrFields)
    With sel.PrimaryItem
      .AddRow visSectionProp, 1, visTagDefault
      iRow = .RowCount(visSectionProp) - 1
      sVal = arrFields(i)
      .CellsSRC(visSectionProp, iRow, visCustPropsValue).RowNameU = sVal
      .CellsSRC(visSectionProp, iRow, visCustPropsValue).FormulaForceU = """"""
      .CellsSRC(visSectionProp, iRow, visCustPropsType).FormulaForceU = "0"
    End With
  Next i
  
'  Application.ActiveWindow.Shape.AddRow visSectionProp, 2, visTagDefault
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsValue).FormulaForceU = "0"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsPrompt).FormulaForceU = """"""
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsLabel).FormulaForceU = """"""
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsFormat).FormulaForceU = """"""
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsSortKey).FormulaForceU = """"""
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsType).FormulaForceU = "0"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsInvis).FormulaForceU = "FALSE"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsAsk).FormulaForceU = "FALSE"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsDataLinked).FormulaForceU = "FALSE"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsLangID).FormulaForceU = "3081"
'  Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 3, visCustPropsCalendar).FormulaForceU = "0"
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia

Last edited by Guessed; 04-01-2019 at 10:40 PM. Reason: added sample code
Reply With Quote