Initial commit

VBAMake.txt

@@ -0,0 +1,37 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = Concept-Subjects
+name = Концепт-Субъекты
+description = Технология визуализации позиций субъектов
+artifact_home = Концепт-Субъекты
+source_home = Concept-Subjects
+install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\01 Высокие технологии\Концепт-Субъекты
+
+%%
+# === Build section ===
+# Available commands:
+#   build LOCAL_MANIFEST
+#   copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+#   save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+#   run LOCAL_SOURCE.bat
+
+build script\manifest.txt
+copy distr\!Реестр противоречий.xlsm
+copy distr\Пример входных данных.xlsx
+copy distr\Версии
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+install Версии
+install !Карта субъектов.vsdm
+install !Реестр противоречий.xlsm
+install Пример входных данных.xlsx

VERSION

@@ -0,0 +1 @@
+1.0.0

script/manifest.txt

@@ -0,0 +1,80 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = !Карта субъектов.vsdm
+artifact = !Карта субъектов.vsdm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+dev
+	DevTester.bas
+
+api
+	ex_WinAPI.bas
+	API_VsoWrapper.cls
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+utility
+	ex_VBA.bas
+	ex_Collection.bas
+	
+	CDS_NodeSH.cls
+	CDS_StaticHierarchy.cls
+
+visio
+	z_VsoUtilities.bas
+	API_ShapeStorage.cls
+	API_UndoWrapper.cls
+	
+ui
+	CSE_ProgressBar.frm
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	ImportDialog.frm
+	
+	DevHelper.bas
+	Declarations.bas
+	Main.bas
+	MainImpl.bas
+	z_UIMessages.bas
+	z_UIRibbon.bas
+	
+	ShapeCreator.cls
+	VisioNode.cls
+	LayoutManager.cls
+	ContainerLayout.cls
+	PageLayout.cls
+
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+.rels -> _rels\.rels
+customUI1.xml -> visio\customUI\customUI1.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Shell32
+global : Scripting
+global : Excel
+global : MSForms

src/ContainerLayout.cls

@@ -0,0 +1,132 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ContainerLayout"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ====== Reusable columns layout =========
+Option Explicit
+
+Private container_ As Visio.Shape
+
+Private margins_ As Double
+Private headerSize_ As Double
+Private maxHeight_ As Double
+
+Private columnWidth_ As Double
+Private lastColumn_ As Collection
+Private originX_ As Double
+Private originY_ As Double
+Private currentY_ As Double
+Private currentX_ As Double
+
+Public Function Init(target As Visio.Shape, maxHeight As Double)
+  Set container_ = target
+  maxHeight_ = maxHeight
+  
+  margins_ = container_.CellsU(CELLSU_CONTAINER_MARGINS) + LM_MARGINS_EPSILON
+  headerSize_ = container_.Shapes(2).CellsU("Height")
+  
+  Call container_.Resize(visResizeDirS, container_.Shapes(2).CellsU("Height") + 2 * margins_ - container_.CellsU("Height"), visInches)
+  originY_ = container_.CellsU("PinY") + container_.CellsU("Height") / 2#
+  currentY_ = originY_ - container_.Shapes(2).CellsU("Height") - margins_
+  
+  originX_ = container_.CellsU("PinX") - container_.CellsU("Width") / 2#
+  currentX_ = originX_ + margins_
+  
+  columnWidth_ = 0
+  Set lastColumn_ = New Collection
+End Function
+
+Public Property Get AreaHeight() As Double
+  AreaHeight = container_.CellsU("Height") - 2 * margins_ - headerSize_
+End Property
+
+Public Property Get AreaWidth() As Double
+  AreaWidth = container_.CellsU("Width") - 2 * margins_
+End Property
+
+Public Function AddItem(target As Visio.Shape)
+  If Not CanAdd(target) Then _
+    Call FinalizeColumn
+  Call AddShapeInternal(target)
+End Function
+
+Public Function AddItemToNewColumn(target As Visio.Shape)
+  Call FinalizeColumn
+  Call AddShapeInternal(target)
+End Function
+
+Public Function Finalize()
+  Call FinalizeColumn
+End Function
+
+' ================
+Private Function CanAdd(target As Visio.Shape) As Boolean
+  If lastColumn_.Count = 0 Then
+    CanAdd = False
+    Exit Function
+  End If
+  
+  Dim newHeight As Double: newHeight = Abs(originY_ - currentY_) + target.CellsU("Height") + LM_VERTICAL_GAP
+  If Round(newHeight + margins_, DEPSILON) < Round(container_.CellsU("Height"), DEPSILON) Then
+    CanAdd = True
+    Exit Function
+  End If
+    
+  CanAdd = Round(newHeight + margins_, DEPSILON) < Round(maxHeight_, DEPSILON)
+End Function
+
+Private Function AddShapeInternal(target As Visio.Shape)
+  Dim newHeight As Double: newHeight = Abs(originY_ - currentY_) + target.CellsU("Height")
+  Call EnsureHeight(newHeight + margins_)
+  
+  Dim newWidth As Double: newWidth = Abs(originX_ - currentX_) + target.CellsU("Width")
+  Call EnsureWidth(newWidth + margins_)
+  
+  Call target.SetCenter(originX_ + newWidth - target.CellsU("Width") / 2#, _
+                        originY_ - newHeight + target.CellsU("Height") / 2#)
+  currentY_ = originY_ - newHeight - LM_VERTICAL_GAP
+  If Round(target.CellsU("Width"), DEPSILON) > Round(columnWidth_, DEPSILON) Then _
+    columnWidth_ = target.CellsU("Width")
+  
+  Call lastColumn_.Add(target)
+End Function
+
+Private Function EnsureHeight(newHeight As Double)
+  If Round(newHeight, DEPSILON) < Round(container_.CellsU("Height"), DEPSILON) Then _
+    Exit Function
+  Call container_.Resize(visResizeDirS, newHeight - container_.CellsU("Height"), visInches)
+End Function
+
+Private Function EnsureWidth(newWidth As Double)
+  If Round(newWidth, DEPSILON) < Round(container_.CellsU("Width"), DEPSILON) Then _
+    Exit Function
+  Call container_.Resize(visResizeDirE, newWidth - container_.CellsU("Width"), visInches)
+End Function
+
+Private Function FinalizeColumn()
+  If lastColumn_.Count = 0 Then _
+    Exit Function
+
+  Call EqualizeWidth
+  
+  currentX_ = currentX_ + columnWidth_ + LM_HORIZONTAL_GAP
+  currentY_ = originY_ - container_.Shapes(2).CellsU("Height") - margins_
+  columnWidth_ = 0
+  Set lastColumn_ = New Collection
+End Function
+
+Private Function EqualizeWidth()
+  Dim nItem&
+  Dim aShape As Visio.Shape
+  For nItem = 1 To lastColumn_.Count Step 1
+    Set aShape = lastColumn_.Item(nItem)
+    If Round(columnWidth_, DEPSILON) > Round(aShape.CellsU("Width"), DEPSILON) Then
+      Call aShape.Resize(visResizeDirE, columnWidth_ - aShape.CellsU("Width"), visInches)
+    End If
+  Next nItem
+End Function

src/DataAcces.bas

@@ -0,0 +1,52 @@
+Attribute VB_Name = "DataAcces"
+Option Explicit
+
+Private Enum DataSourceStructure
+  DSS_ID = 1
+  DSS_LEVEL = 2
+  DSS_TYPE = 3
+  DSS_TEXT_THEME = 4
+  DSS_TEXT_SUBJECT = 5
+End Enum
+
+Public Function ScanExcel(target As Excel.Worksheet) As Hierarchy
+  Set ScanExcel = New Hierarchy
+  
+  Call CSE_ProgressBar.Init("Ñêàíèðîâàíèå òàáëèöû", maxVal:=target.UsedRange.Rows.Count, curVal:=2)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Dim theType As ItemType
+  Dim theText$
+  Dim nRow&: nRow = 2
+  Do While target.Cells(nRow, DSS_LEVEL) <> ""
+    theType = TextToType(target.Cells(nRow, DSS_TYPE))
+    If theType = IT_ORGAN Or theType = IT_PERSON Or theType = IT_GROUP Then
+      theText = target.Cells(nRow, DSS_TEXT_SUBJECT)
+    Else
+      theText = target.Cells(nRow, DSS_TEXT_THEME)
+    End If
+    
+    If ScanExcel.AddItem(theType, target.Cells(nRow, DSS_LEVEL), theText) Is Nothing Then
+      Set ScanExcel = Nothing
+      Unload CSE_ProgressBar
+      Exit Function
+    End If
+
+    Call CSE_ProgressBar.IncrementA
+    nRow = nRow + 1
+  Loop
+  
+  Unload CSE_ProgressBar
+End Function
+
+' ===========
+Private Function TextToType(target$) As ItemType
+ Select Case target
+    Case SHP_TYPE_PROBLEM: TextToType = IT_PROBLEM
+    Case SHP_TYPE_POSITION: TextToType = IT_POSITION
+    Case SHP_TYPE_GROUP: TextToType = IT_GROUP
+    Case SHP_TYPE_ORGAN: TextToType = IT_ORGAN
+    Case SHP_TYPE_PERSON: TextToType = IT_PERSON
+  End Select
+End Function
+

src/Declarations.bas

@@ -0,0 +1,116 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+
+Public Enum TItem
+  T_ITEM_UNKNOWN = 0
+  [_First] = 1
+  
+  T_ITEM_FRONT = 1
+  T_ITEM_PROBLEM = 2
+  T_ITEM_SUBJECT_TYPE = 3
+  T_ITEM_GROUP = 4
+  T_ITEM_ORGAN = 5
+  T_ITEM_PERSON = 6
+  
+  [_Last] = 6
+End Enum
+
+Public Enum TSubjectType
+  T_SUBJECT_UNKNOWN = 0
+  [_First] = 1
+  
+  T_SUBJECT_SOLVER = 1
+  T_SUBJECT_INVOLVED = 2
+  T_SUBJECT_POTENTIAL = 3
+  
+  [_Last] = 3
+End Enum
+
+Public Const SHAPE_FRONT = "Ôðîíò"
+Public Const SHAPE_PROBLEM = "Ïðîáëåìà"
+Public Const SHAPE_SUBJECT_TYPE = "Âèä ñóáúåêòîâ"
+Public Const SHAPE_ORGAN = "Îðãàíèçàöèÿ"
+Public Const SHAPE_PERSON = "Ïåðñîíà"
+Public Const SHAPE_GROUP = "Ãðóïïà"
+
+Public Const XL_TYPE_FRONT = "Ôðîíò"
+Public Const XL_TYPE_PROBLEM = "Ïðîáëåìà"
+Public Const XL_TYPE_SUBJECT_TYPE = "Âèä ñóáúåêòîâ"
+Public Const XL_TYPE_ORGAN = "Îðãàíèçàöèÿ"
+Public Const XL_TYPE_PERSON = "Ïåðñîíà"
+Public Const XL_TYPE_GROUP = "Ãðóïïà"
+
+Public Const SHP_TITLE = "Íàçâàíèå"
+
+Public Const MAX_STRUCTURE_DEPTH = 20
+
+Public Const CELLSU_POSTYPE = "User.ThesisVariant"
+Public Const CELLSU_CONTAINER_MARGINS = "User.msvSDContainerMargin"
+
+Public Const PROBLEM_PREFIX = "Ïðîáëåìà"
+Public Const FRONT_PREFIX = "Ôðîíò ðåøåíèÿ ïðîáëåì"
+
+Public Const DEPSILON = 3
+
+' Layout manager options
+Public Const LM_MARGINS_EPSILON = 0.5 / 25.4 ' Increase margins to ammount for line width etc.
+
+Public Const LM_VERTICAL_GAP = 2 / 25.4
+Public Const LM_HORIZONTAL_GAP = 2 / 25.4
+
+Public Const PAGE_VERTICAL_GAP = 4 / 25.4
+Public Const PAGE_HORIZONTAL_GAP = 4 / 25.4
+
+Public Const PAGE_TITLE_GAP = 25 / 25.4 ' Blank space in left corner for schema title
+
+Public Const HEIGHT_DOUBLE_THRESHOLD = 130
+Public Const HEIGHT_TRIPLE_THRESHOLD = 250
+
+Public Type PageProps
+  width_ As Double
+  height_ As Double
+  frontHeight_ As Double
+  problemHeight_ As Double
+  leftGap_ As Double
+  columnGap_ As Double
+  addHeader_ As Boolean
+  multipage_ As Boolean
+End Type
+
+' Custom errors
+Public Enum CustomErrors
+  ERR_XL_INVALID_TYPE = vbObjectError + 1000
+ ' ERR_SYNC_DOC
+End Enum
+
+' ===== Excel input ==========
+Public Const EXCEL_FIRST_ROW = 2
+
+Public Enum DataSourceStructure
+  S_ITEM_ID = 1
+  S_ITEM_LEVEL = 2
+  S_ITEM_TYPE = 3
+  S_ITEM_TEXT_THEME = 4
+  S_ITEM_TEXT_SUBJECT = 5
+End Enum
+
+Public Function TextToItemType(sText$) As TItem
+  Select Case sText
+  Case XL_TYPE_FRONT: TextToItemType = T_ITEM_FRONT
+  Case XL_TYPE_PROBLEM: TextToItemType = T_ITEM_PROBLEM
+  Case XL_TYPE_SUBJECT_TYPE: TextToItemType = T_ITEM_SUBJECT_TYPE
+  Case XL_TYPE_GROUP: TextToItemType = T_ITEM_GROUP
+  Case XL_TYPE_ORGAN: TextToItemType = T_ITEM_ORGAN
+  Case XL_TYPE_PERSON: TextToItemType = T_ITEM_PERSON
+  Case Else: TextToItemType = T_ITEM_UNKNOWN
+  End Select
+End Function
+
+Public Function TextToSubjectType(sText$) As TSubjectType
+  Select Case sText
+  Case "Ñóáúåêòû ðåøåíèÿ ïðîáëåìû": TextToSubjectType = T_SUBJECT_SOLVER
+  Case "Ñóáúåêòû ïðîáëåìíîé äåÿòåëüíîñòè": TextToSubjectType = T_SUBJECT_INVOLVED
+  Case "Ïîòåíöèàëüíûå ñóáúåêòû": TextToSubjectType = T_SUBJECT_POTENTIAL
+  Case Else: TextToSubjectType = T_SUBJECT_POTENTIAL
+  End Select
+End Function

src/DevHelper.bas

@@ -0,0 +1,22 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+  Call ClearMain
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_UndoWrapper"
+  Dim sTest$: sTest = "t_BasicUndo"
+  Dim sMsg$: sMsg = Dev_RunTest(sSuite, sTest)
+  Debug.Print sMsg
+  Call MsgBox(sMsg)
+End Function
+
+Public Function Dev_GetTestSuite(sName$) As Object
+  Select Case sName
+  '  Case "s_UndoWrapper": Set Dev_GetTestSuite = New s_UndoWrapper
+  End Select
+End Function

src/ImportDialog.frm

@@ -0,0 +1,75 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ImportDialog 
+   Caption         =   "Èìïîðò äàííûõ"
+   ClientHeight    =   5115
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   3525
+   OleObjectBlob   =   "ImportDialog.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "ImportDialog"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCancelled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCancelled_ = True
+End Sub
+
+Private Sub UserForm_Terminate()
+  isCancelled_ = True
+  Call Me.Hide
+End Sub
+
+Public Function Init(pHeightInMM As Double)
+  isCancelled_ = True
+  TBPrintHeight.Value = CLng(pHeightInMM)
+End Function
+
+Public Property Get FileName() As String
+  FileName = TBDocument.Text
+End Property
+
+Public Function GetProps() As PageProps
+  With GetProps
+    .addHeader_ = CBTitle.Value
+    .multipage_ = CBMultipage.Value
+    .height_ = Visio.Application.ConvertResult(TBPrintHeight.Value, visMillimeters, visInches)
+    .width_ = Visio.Application.ConvertResult(TBPrintWidth.Value, visMillimeters, visInches)
+    .problemHeight_ = Visio.Application.ConvertResult(TBIemHeight.Value, visMillimeters, visInches)
+    .frontHeight_ = Visio.Application.ConvertResult(TBFrontHeight.Value, visMillimeters, visInches)
+    .leftGap_ = Visio.Application.ConvertResult(TBHorizontalGap.Value, visMillimeters, visInches)
+    .columnGap_ = Visio.Application.ConvertResult(TBColumnGap.Value, visMillimeters, visInches)
+  End With
+End Function
+
+' ==========
+Private Sub DocumentBtn_Click()
+  Dim sFile$: sFile = UserInteraction.PromptFileFilter( _
+                                            sInitialPath:=ThisDocument.Path, _
+                                            bNewApplication:=True, _
+                                            sDescription:="Äîêóìåíò Excel", _
+                                            sFilter:="*.xlsx;*.xls;*.xlsm")
+  If sFile <> vbNullString Then _
+    TBDocument.Text = sFile
+End Sub
+
+Private Sub CancelBtn_Click()
+  isCancelled_ = True
+  Call Me.Hide
+End Sub
+
+Private Sub OkBtn_Click()
+  If FileName = vbNullString Then
+    Call UserInteraction.ShowMessage(EM_VALIDATION_FAIL)
+    Exit Sub
+  End If
+  
+  isCancelled_ = False
+  Call Me.Hide
+End Sub

src/LayoutManager.cls

@@ -0,0 +1,200 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "LayoutManager"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' ====== Shape layout and combination logic ========
+Option Explicit
+
+Private data_ As CDS_StaticHierarchy
+Private storage_ As API_ShapeStorage
+
+Private parentPage_ As Visio.Page
+
+Private pageProps_ As PageProps
+Private originX_ As Double
+Private originY_ As Double
+
+Public Function Init(ByRef theData As CDS_StaticHierarchy, ByRef iStorage As API_ShapeStorage, originX As Double, originY As Double)
+  Set data_ = theData
+  Set storage_ = iStorage
+  Set parentPage_ = iStorage.TargetPage
+  originX_ = originX
+  originY_ = originY
+End Function
+
+Public Function CombineContainers(props As PageProps)
+  pageProps_ = props
+  Dim iNode As CDS_NodeSH
+  For Each iNode In data_.nodes_
+    If iNode.rank_ = 1 Then _
+      Call PrepareItem(iNode, props.frontHeight_)
+    Call CSE_ProgressBar.IncrementA
+  Next iNode
+  Call ActiveWindow.Selection.DeselectAll
+End Function
+
+Public Function Build(props As PageProps)
+  Dim iPage As New PageLayout: Call iPage.Init(parentPage_, props)
+  Dim itemShape As Visio.Shape
+  Dim iNode As CDS_NodeSH
+  For Each iNode In data_.nodes_
+    If iNode.rank_ = 1 Then
+      Set itemShape = iNode.data_.shape_
+      Call storage_.GiveBack(itemShape)
+      Call iPage.AddItem(itemShape)
+      Call CSE_ProgressBar.IncrementA
+    End If
+  Next iNode
+  Call iPage.FinalizePage
+End Function
+
+' =======
+Private Function PrepareItem(target As CDS_NodeSH, dMaxHeight As Double) ' recursive
+  If target.children_.Count = 0 Then _
+    Exit Function
+  Select Case target.data_.type_
+    Case T_ITEM_FRONT: Call PrepareFront(target)
+    Case T_ITEM_PROBLEM: Call PrepareProblem(target, pageProps_.problemHeight_)
+    Case T_ITEM_SUBJECT_TYPE, T_ITEM_GROUP: Call PrepareContainer(target, dMaxHeight)
+    Case T_ITEM_ORGAN: Call PrepareOrgan(target)
+    Case Else: Call Err.Raise(1000, Description:="Structural error in " & target.data_.text_)  ' TODO: specify err number
+  End Select
+End Function
+
+Private Function PrepareChildren(target As CDS_NodeSH, dMaxHeight As Double)
+  Dim iChildNode As CDS_NodeSH
+  For Each iChildNode In target.children_
+    Call PrepareItem(iChildNode, dMaxHeight)
+  Next iChildNode
+End Function
+
+Private Function PrepareFront(target As CDS_NodeSH)
+  Dim dHeight As Double: dHeight = pageProps_.frontHeight_
+  If target.descendantsCount_ > HEIGHT_TRIPLE_THRESHOLD Then
+    dHeight = dHeight * 3
+  ElseIf target.descendantsCount_ > HEIGHT_DOUBLE_THRESHOLD Then
+    dHeight = dHeight * 2
+  End If
+  Dim iLayout As ContainerLayout
+  Set iLayout = CreateLayout(target, dHeight)
+  Call storage_.GiveBack(target.data_.shape_)
+  Call IncludeFrontChildren(target, iLayout)
+  Call iLayout.Finalize
+  Call storage_.Store(target.data_.shape_)
+End Function
+
+Private Function PrepareProblem(target As CDS_NodeSH, dMaxHeight As Double)
+  Dim iLayout As ContainerLayout
+  Set iLayout = CreateLayout(target, dMaxHeight)
+  Call storage_.GiveBack(target.data_.shape_)
+  Call IncludeProblemChildren(target, iLayout)
+  Call iLayout.Finalize
+  Call storage_.Store(target.data_.shape_)
+End Function
+
+Private Function PrepareContainer(target As CDS_NodeSH, dMaxHeight As Double)
+  Dim iLayout As ContainerLayout
+  Set iLayout = CreateLayout(target, dMaxHeight)
+  Call storage_.GiveBack(target.data_.shape_)
+  Call IncludeContainerChildren(target, iLayout)
+  Call iLayout.Finalize
+  Call storage_.Store(target.data_.shape_)
+End Function
+
+Private Function PrepareOrgan(target As CDS_NodeSH)
+  Call storage_.GiveBack(target.data_.shape_)
+  Set target.data_.shape_ = GroupWithChildren(target)
+  Call storage_.Store(target.data_.shape_)
+End Function
+
+Private Function CreateLayout(target As CDS_NodeSH, dMaxHeight As Double) As ContainerLayout
+  Dim iParent As Visio.Shape: Set iParent = target.data_.shape_
+  Dim newMaxHeight As Double: newMaxHeight = dMaxHeight - HeightBoilerplate(iParent)
+  Call PrepareChildren(target, newMaxHeight)
+  
+  Call iParent.SetCenter(originX_ + iParent.CellsU("Width") / 2#, originY_ - iParent.CellsU("Height") / 2#)
+  Dim aLayout As New ContainerLayout: Call aLayout.Init(iParent, dMaxHeight)
+  Set CreateLayout = aLayout
+End Function
+
+Private Function IncludeFrontChildren(target As CDS_NodeSH, iLayout As ContainerLayout)
+  Dim iChildNode As CDS_NodeSH
+  For Each iChildNode In target.children_
+    Dim iChild As Visio.Shape: Set iChild = iChildNode.data_.shape_
+    Call storage_.GiveBack(iChild)
+    Call iLayout.AddItem(iChild)
+  Next iChildNode
+End Function
+
+Private Function IncludeProblemChildren(target As CDS_NodeSH, iLayout As ContainerLayout)
+  Dim iChildNode As CDS_NodeSH
+  For Each iChildNode In target.children_
+    Dim iChild As Visio.Shape: Set iChild = iChildNode.data_.shape_
+    Call storage_.GiveBack(iChild)
+    Call iLayout.AddItemToNewColumn(iChild)
+  Next iChildNode
+  
+  For Each iChildNode In target.children_
+    Call iChildNode.data_.shape_.Resize(visResizeDirS, iLayout.AreaHeight - iChildNode.data_.shape_.CellsU("Height"), visInches)
+  Next iChildNode
+End Function
+
+Private Function IncludeContainerChildren(target As CDS_NodeSH, iLayout As ContainerLayout)
+  Dim nLastType As TItem: nLastType = T_ITEM_PROBLEM
+  Dim iChildNode As CDS_NodeSH
+  For Each iChildNode In target.children_
+    Dim iChild As Visio.Shape: Set iChild = iChildNode.data_.shape_
+    Call storage_.GiveBack(iChild)
+    If nLastType = iChildNode.data_.type_ Then
+      Call iLayout.AddItem(iChild)
+    Else
+      Call iLayout.AddItemToNewColumn(iChild)
+    End If
+    nLastType = iChildNode.data_.type_
+  Next iChildNode
+End Function
+
+Private Function GroupWithChildren(target As CDS_NodeSH) As Visio.Shape
+  Dim iParent As Visio.Shape: Set iParent = target.data_.shape_
+  Call iParent.SetCenter(originX_ + iParent.CellsU("Width") / 2#, originY_ - iParent.CellsU("Height") / 2#)
+  
+  Dim groupSel As Visio.Selection: Set groupSel = parentPage_.CreateSelection(visSelTypeEmpty)
+  Call groupSel.Select(iParent, visSelect)
+  
+  Dim posY As Double: posY = originY_ - iParent.CellsU("Height")
+  Dim maxWidth As Double: maxWidth = iParent.CellsU("Width")
+  
+  Dim iChildNode As CDS_NodeSH
+  For Each iChildNode In target.children_
+    Dim iChild As Visio.Shape: Set iChild = iChildNode.data_.shape_
+    Call storage_.GiveBack(iChild)
+    Call groupSel.Select(iChild, visSelect)
+    posY = posY - iChild.CellsU("Height")
+    Call iChild.SetCenter(originX_ + iChild.CellsU("Width") / 2#, posY + iChild.CellsU("Height") / 2#)
+    If VBA.Round(maxWidth, DEPSILON) < VBA.Round(iChild.CellsU("Width"), DEPSILON) Then _
+      maxWidth = iChild.CellsU("Width")
+  Next iChildNode
+  
+  Dim aShape As Visio.Shape
+  For Each aShape In groupSel
+    If VBA.Round(maxWidth, DEPSILON) > VBA.Round(aShape.CellsU("Width"), DEPSILON) Then
+      Call aShape.Resize(visResizeDirE, maxWidth - aShape.CellsU("Width"), visInches)
+    End If
+  Next aShape
+  
+  Set GroupWithChildren = groupSel.Group
+End Function
+
+Private Function HeightBoilerplate(target As Visio.Shape) As Double
+  If target.Shapes.Count < 2 Then
+    HeightBoilerplate = 0
+    Exit Function
+  End If
+  HeightBoilerplate = target.Shapes(2).CellsU("Height")
+  HeightBoilerplate = HeightBoilerplate + 2 * (target.CellsU(CELLSU_CONTAINER_MARGINS) + LM_MARGINS_EPSILON)
+End Function

src/Main.bas

@@ -0,0 +1,96 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Sub RunGenerator()
+  Dim thePage As Visio.Page: Set thePage = MainPage()
+  Call ImportDialog.Init(thePage.PageSheet.CellsU("PageHeight").Result(visMillimeters))
+  Call ImportDialog.Show
+  If ImportDialog.isCancelled_ Then _
+    Exit Sub
+  
+  Dim theData As CDS_StaticHierarchy: Set theData = ExtractData(ImportDialog.FileName)
+  If theData Is Nothing Then _
+    Exit Sub
+  
+  If theData.nodes_.Count = 0 Then
+    Call UserInteraction.ShowMessage(EM_DATA_EMPTY)
+    Exit Sub
+  End If
+  
+  Call GlobalUndo.BeginScope("Î÷èñòêà")
+  Call VsoClearPage(MainPage())
+  Call GlobalUndo.EndScope
+  
+  Call GlobalUndo.BeginScope("Ãåíåðàöèÿ ñõåìû")
+  Call CSE_ProgressBar.Init("Ãåíåðàöèÿ ñõåìû", maxVal:=theData.nodes_.Count, curVal:=1)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Dim iStorage As API_ShapeStorage
+  Set iStorage = CreateShapesFor(theData, MainPage())
+  
+  Dim iManager As New LayoutManager
+  Call iManager.Init(theData, iStorage, originX:=0, originY:=thePage.PageSheet.CellsU("PageHeight"))
+  
+  ThisDocument.DiagramServicesEnabled = visServiceAll
+  
+  Call CSE_ProgressBar.Init("Êîìáèíèðîâàíèå ôèãóð", maxVal:=theData.nodes_.Count, curVal:=1)
+   Call iManager.CombineContainers(ImportDialog.GetProps)
+  
+  Call CSE_ProgressBar.Init("Ðàññòàíîâêà ôèãóð", maxVal:=iStorage.items_.Count, curVal:=1)
+  Call iManager.Build(ImportDialog.GetProps)
+  
+  ThisDocument.DiagramServicesEnabled = visServiceNone
+  
+  Call Unload(CSE_ProgressBar)
+  Call GlobalUndo.EndScope
+  
+  Call VsoShowWholePage(thePage)
+  Call UserInteraction.ShowMessage(IM_GENERATION_OK, _
+                                    theData.nodes_.Count, _
+                                    VBA.Round(thePage.PageSheet.CellsU("PageHeight").Result(visMillimeters), 0), _
+                                    VBA.Round(thePage.PageSheet.CellsU("PageWidth").Result(visMillimeters), 0))
+End Sub
+
+Public Sub ClearMain()
+  Call VsoClearPage(MainPage)
+End Sub
+
+Public Sub DeleteAllPages()
+  Dim thePage As Visio.Page: Set thePage = MainPage()
+  Dim target As Visio.Page
+  Dim nPage&: nPage = 1
+  Do While nPage <= ThisDocument.Pages.Count
+    Set target = ThisDocument.Pages(nPage)
+    If target.Name = thePage.Name Then
+      nPage = nPage + 1
+    Else
+      Call target.Delete(True)
+    End If
+  Loop
+End Sub
+
+' ====
+Private Function MainPage() As Visio.Page
+  Set MainPage = Application.ActiveDocument.Pages(1)
+End Function
+
+Private Function ExtractData(targetPath$) As CDS_StaticHierarchy
+  Dim wrap As New API_XLWrapper
+  If wrap.OpenDocument(targetPath, bReadOnly:=True) Is Nothing Then _
+    Exit Function
+  
+  Call CSE_ProgressBar.Init("Ñêàíèðîâàíèå òàáëèöû", maxVal:=wrap.Document.Worksheets(1).UsedRange.Rows.Count, curVal:=2)
+  Call CSE_ProgressBar.ShowModeless
+  
+  On Error Resume Next
+  Set ExtractData = ScanExcel(wrap.Document.Worksheets(1))
+  Call ProcessErrorMessages(UniqueList(ERR_XL_INVALID_TYPE))
+  On Error GoTo 0
+  
+  Call Unload(CSE_ProgressBar)
+  
+  If ExtractData Is Nothing Then _
+    Call UserInteraction.ShowMessage(EM_INVALID_FILE_FORMAT)
+    
+  Call wrap.ReleaseDocument
+End Function

src/MainImpl.bas

@@ -0,0 +1,76 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+
+Public Function ProcessErrorMessages(expectedErrors As Scripting.Dictionary)
+  If Err.Number = 0 Then _
+    Exit Function
+    
+  Unload CSE_ProgressBar
+  If Not expectedErrors.Exists(Err.Number) Then _
+    Call Err.Raise(Err.Number)
+  
+  Select Case Err.Number
+    Case ERR_XL_INVALID_TYPE: Call UserInteraction.ShowMessage(Err.Number, Err.Source)
+  End Select
+End Function
+
+Public Function ScanExcel(target As Excel.Worksheet) As CDS_StaticHierarchy
+  Dim iData As New CDS_StaticHierarchy
+  Dim nPosition As TSubjectType
+  Dim iNode As CDS_NodeSH
+  Dim nRow&: nRow = EXCEL_FIRST_ROW
+  Do While target.Cells(nRow, S_ITEM_LEVEL) <> ""
+    Set iNode = iData.PushItem(target.Cells(nRow, S_ITEM_LEVEL))
+    If iNode Is Nothing Then _
+      Exit Function
+    Set iNode.data_ = ExtractPayload(nRow, target)
+    
+    If iNode.data_.type_ = T_ITEM_SUBJECT_TYPE Then _
+      nPosition = TextToSubjectType(iNode.data_.text_)
+      
+    If iNode.rank_ >= 3 Then _
+      iNode.data_.position_ = nPosition
+    
+    Call CSE_ProgressBar.IncrementA
+    nRow = nRow + 1
+  Loop
+  
+  Set ScanExcel = iData
+End Function
+
+Public Function CreateShapesFor(ByRef theData As CDS_StaticHierarchy, ByRef dest As Visio.Page) As API_ShapeStorage
+  Dim iCreator As New ShapeCreator
+  Call iCreator.Init(theData, dest)
+  Set CreateShapesFor = iCreator.CreateAllShapes()
+End Function
+
+Public Function GetMasterFor(theType As TItem) As Visio.Master
+  Select Case theType
+  Case T_ITEM_FRONT: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_FRONT)
+  Case T_ITEM_PROBLEM: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_PROBLEM)
+  Case T_ITEM_SUBJECT_TYPE: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_SUBJECT_TYPE)
+  Case T_ITEM_GROUP: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_GROUP)
+  Case T_ITEM_ORGAN: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_ORGAN)
+  Case T_ITEM_PERSON: Set GetMasterFor = FindMaster(ThisDocument, SHAPE_PERSON)
+  End Select
+End Function
+
+' =============
+Private Function ExtractPayload(nRow&, iSource As Excel.Worksheet) As VisioNode
+  Dim nType As TItem: nType = TextToItemType(iSource.Cells(nRow, S_ITEM_TYPE))
+  nType = TextToItemType(iSource.Cells(nRow, S_ITEM_TYPE))
+  If nType = T_ITEM_UNKNOWN Then _
+    Call Err.Raise(ERR_XL_INVALID_TYPE, nRow)
+  
+  Dim sText$
+  If nType = T_ITEM_ORGAN Or nType = T_ITEM_PERSON Or nType = T_ITEM_GROUP Then
+    sText = iSource.Cells(nRow, S_ITEM_TEXT_SUBJECT)
+  Else
+    sText = iSource.Cells(nRow, S_ITEM_TEXT_THEME)
+  End If
+  
+  Dim iPayload As New VisioNode
+  Call iPayload.Init(nType, sText)
+  Set ExtractPayload = iPayload
+End Function
+

src/PageLayout.cls

@@ -0,0 +1,155 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "PageLayout"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private page_ As Visio.Page
+Private props_ As PageProps
+
+Private originX_ As Double
+Private originY_ As Double
+
+Private columnWidth_ As Double
+Private lastColumn_ As Collection
+Private columnCount_ As Long
+
+Private currentY_ As Double
+Private currentX_ As Double
+
+Public Function Init(ByRef target As Visio.Page, props As PageProps)
+  props_ = props
+  Set page_ = target
+
+  Set lastColumn_ = New Collection
+  columnCount_ = 0
+  columnWidth_ = 0
+  originX_ = 0
+  originY_ = props_.height_
+  
+  target.PageSheet.CellsU("PageHeight") = props.height_
+  
+  currentX_ = originX_ + props_.leftGap_
+  currentY_ = originY_ - PAGE_VERTICAL_GAP
+  If props.addHeader_ Then
+    Call AddTitle
+    currentY_ = originY_ - PAGE_TITLE_GAP
+  End If
+End Function
+
+Public Function AddItem(target As Visio.Shape)
+  If Not CanAdd(target) Then _
+    Call FinalizeColumn
+  Call AddShapeInternal(target)
+End Function
+
+Public Function AddItemToNewColumn(target As Visio.Shape)
+  Call FinalizeColumn
+  Call AddShapeInternal(target)
+End Function
+
+Public Function FinalizePage()
+  Call FinalizeColumn
+  If Not props_.multipage_ Then _
+    page_.PageSheet.CellsU("PageWidth") = currentX_
+End Function
+
+' ================
+Private Function CanAdd(target As Visio.Shape) As Boolean
+  Dim newHeight As Double: newHeight = Abs(originY_ - currentY_) + target.CellsU("Height") + PAGE_VERTICAL_GAP
+  CanAdd = Round(newHeight, DEPSILON) < Round(props_.height_, DEPSILON)
+End Function
+
+Private Function AddShapeInternal(target As Visio.Shape)
+  Dim newHeight As Double: newHeight = Abs(originY_ - currentY_) + target.CellsU("Height")
+  Dim newWidth As Double: newWidth = Abs(originX_ - currentX_) + target.CellsU("Width")
+  
+  Call target.SetCenter(originX_ + newWidth - target.CellsU("Width") / 2#, _
+                        originY_ - newHeight + target.CellsU("Height") / 2#)
+  currentY_ = originY_ - newHeight - PAGE_VERTICAL_GAP
+  If Round(target.CellsU("Width"), DEPSILON) > Round(columnWidth_, DEPSILON) Then _
+    columnWidth_ = target.CellsU("Width")
+  
+  Call lastColumn_.Add(target)
+End Function
+
+Private Function FinalizeColumn()
+  If lastColumn_.Count = 0 Then _
+    Exit Function
+  
+  columnCount_ = columnCount_ + 1
+  ' Call EqualizeWidth ' Note: do not equalize width for fronts
+  
+  If props_.multipage_ Then
+    Call CopyColumnToNewPage
+    currentX_ = originX_ + props_.leftGap_
+  ElseIf props_.width_ = 0 Then
+    currentX_ = currentX_ + columnWidth_ + props_.columnGap_
+  Else
+    Dim nPageCount&: nPageCount = 1 + Int(currentX_ / props_.width_)
+    Dim pageEdge As Double: pageEdge = originX_ + nPageCount * props_.width_
+    
+    If columnCount_ > 1 And VBA.Round(pageEdge, DEPSILON) < VBA.Round(currentX_ + columnWidth_ + props_.leftGap_, DEPSILON) Then
+      Call AdjustLastColumnX(pageEdge - currentX_)
+      currentX_ = pageEdge + columnWidth_ + props_.columnGap_
+    Else
+      currentX_ = currentX_ + columnWidth_ + props_.columnGap_
+    End If
+  End If
+  
+  currentY_ = originY_ - PAGE_VERTICAL_GAP
+  columnWidth_ = 0
+  Set lastColumn_ = New Collection
+End Function
+
+Private Function EqualizeWidth()
+  Dim nItem&
+  Dim aShape As Visio.Shape
+  For nItem = 1 To lastColumn_.Count Step 1
+    Set aShape = lastColumn_.Item(nItem)
+    If Round(columnWidth_, DEPSILON) > Round(aShape.CellsU("Width"), DEPSILON) Then
+      Call aShape.Resize(visResizeDirE, columnWidth_ - aShape.CellsU("Width"), visInches)
+    End If
+  Next nItem
+End Function
+
+Private Function AddTitle()
+  Dim titleShape As Visio.Shape: Set titleShape = page_.Drop(FindMaster(page_.Document, SHP_TITLE), PAGE_HORIZONTAL_GAP, props_.height_ - PAGE_VERTICAL_GAP)
+  titleShape.CellsU("PinY") = props_.height_ - PAGE_VERTICAL_GAP - titleShape.CellsU("Height") / 2#
+  titleShape.CellsU("PinX") = PAGE_HORIZONTAL_GAP + titleShape.CellsU("Width") / 2#
+  Call lastColumn_.Add(titleShape)
+End Function
+
+Private Function AdjustLastColumnX(xDiff As Double)
+  Dim nItem&
+  Dim aShape As Visio.Shape
+  For nItem = 1 To lastColumn_.Count Step 1
+    Set aShape = lastColumn_.Item(nItem)
+    aShape.Cells("PinX") = aShape.Cells("PinX") + xDiff
+  Next nItem
+End Function
+
+Private Function CopyColumnToNewPage()
+  Dim newPage As Visio.Page:  Set newPage = page_.Document.Pages.Add
+  newPage.PageSheet.CellsU("PageHeight") = page_.PageSheet.CellsU("PageHeight")
+  If props_.width_ = 0 Then
+    newPage.PageSheet.CellsU("PageWidth") = currentX_ + columnWidth_
+  Else
+    newPage.PageSheet.CellsU("PageWidth") = props_.width_
+  End If
+  
+  Call SetupFixedGridPage(newPage)
+  
+  Dim aShape As Visio.Shape
+  For Each aShape In lastColumn_
+    Call aShape.Copy(visCopyPasteNoTranslate + visCopyPasteDontAddToContainers + visCopyPasteNoCascade)
+    Call newPage.Paste(visCopyPasteNoTranslate + visCopyPasteDontAddToContainers + visCopyPasteNoCascade)
+    
+    Call aShape.DeleteEx(visDeleteNormal)
+  Next aShape
+End Function

src/ShapeCreator.cls

@@ -0,0 +1,129 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ShapeCreator"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private problemIndex_ As Long
+Private frontIndex_ As Long
+
+Private data_ As CDS_StaticHierarchy
+Private storage_ As API_ShapeStorage
+Private destination_ As Visio.Page
+
+Public Function Init(iData As CDS_StaticHierarchy, iDestination As Visio.Page)
+  problemIndex_ = 0
+  frontIndex_ = 0
+  
+  Set data_ = iData
+  Set destination_ = iDestination
+  Set storage_ = New API_ShapeStorage
+  Call storage_.Init(0, iDestination.PageSheet.Cells("PageHeight"))
+End Function
+
+Public Function CreateAllShapes() As API_ShapeStorage
+  Dim iNode As CDS_NodeSH
+  For Each iNode In data_.nodes_
+    If iNode.rank_ = 1 Then _
+      Call CreateRecursive(iNode)
+  Next iNode
+  Set CreateAllShapes = storage_
+End Function
+
+' ========
+Private Function CreateRecursive(target As CDS_NodeSH)
+  Call CreateItemShape(target)
+  Call storage_.Store(target.data_.shape_)
+  Call CSE_ProgressBar.IncrementA
+  
+  If target.children_.Count = 0 Then _
+    Exit Function
+    
+  Dim iChild As CDS_NodeSH
+  Dim iChildren As Collection: Set iChildren = OrderChildren(target)
+  For Each iChild In iChildren
+    Call CreateRecursive(iChild)
+  Next iChild
+End Function
+
+Private Function CreateItemShape(ByRef target As CDS_NodeSH)
+  Dim iShape As Visio.Shape: Set iShape = destination_.Drop(GetMasterFor(target.data_.type_), 0, 0)
+  Set target.data_.shape_ = iShape
+  iShape.Text = target.data_.text_
+  If target.data_.type_ = T_ITEM_PROBLEM Then
+    Call AddProblemPrefix(target, iShape)
+    iShape.Shapes(2).CellsU("Width") = iShape.Shapes(2).CellsU("Width")
+  ElseIf target.data_.type_ = T_ITEM_FRONT Then
+    Call AddFrontPrefix(target, iShape)
+    iShape.Shapes(2).CellsU("Width") = iShape.Shapes(2).CellsU("Width")
+  Else
+    Call CellsSetValue(iShape, CELLSU_POSTYPE, target.data_.position_)
+    iShape.CellsU("Width") = iShape.CellsU("Width")
+  End If
+End Function
+
+Private Function AddProblemPrefix(iNode As CDS_NodeSH, ByRef iShape As Visio.Shape)
+  problemIndex_ = problemIndex_ + 1
+  Dim sPrefix$: sPrefix = Fmt("{1} {2}. ", PROBLEM_PREFIX, problemIndex_)
+  iShape.Text = sPrefix & iShape.Text
+
+  Dim cCursor As Visio.Characters: Set cCursor = iShape.Shapes(2).Characters
+  cCursor.Begin = 0
+  cCursor.End = VBA.Len(sPrefix)
+  cCursor.CharProps(visCharacterStyle) = visBold
+End Function
+
+Private Function AddFrontPrefix(iNode As CDS_NodeSH, ByRef iShape As Visio.Shape)
+  frontIndex_ = frontIndex_ + 1
+  Dim sPrefix$: sPrefix = Fmt("{1} {2}. ", FRONT_PREFIX, frontIndex_)
+  iShape.Text = sPrefix & iShape.Text
+
+  Dim cCursor As Visio.Characters: Set cCursor = iShape.Shapes(2).Characters
+  cCursor.Begin = 0
+  cCursor.End = VBA.Len(sPrefix)
+  cCursor.CharProps(visCharacterStyle) = visBold
+End Function
+
+Private Function OrderChildren(ByRef target As CDS_NodeSH) As Collection
+  If target.data_.type_ = T_ITEM_FRONT Then _
+    Set target.children_ = OrderByDescendants(target.children_) ' Note: Modifying graph!!
+  Set OrderChildren = target.children_
+End Function
+
+Private Function OrderByDescendants(iInput As Collection) As Collection
+  Dim iDescCounts As New Scripting.Dictionary
+  Dim iOut As New Collection
+  
+  Dim iNode As CDS_NodeSH
+  Dim nDescendants&
+  Dim nIndex&
+  Dim aKey As Variant
+  For Each iNode In iInput
+    nDescendants = iNode.descendantsCount_
+    If iDescCounts.Count = 0 Then
+      Call iOut.Add(iNode, CStr(iNode.id_))
+      Call iDescCounts.Add(iNode.id_, nDescendants)
+    Else
+      nIndex = 1
+      For Each aKey In iDescCounts
+        If iDescCounts(aKey) <= nDescendants Then _
+          nIndex = nIndex + 1
+      Next aKey
+      
+      Call iDescCounts.Add(iNode.id_, nDescendants)
+      
+      If nIndex > iOut.Count Then
+        Call iOut.Add(iNode, CStr(iNode.id_))
+      Else
+        Call iOut.Add(iNode, CStr(iNode.id_), Before:=nIndex)
+      End If
+    End If
+  Next iNode
+  
+  Set OrderByDescendants = iOut
+End Function

src/VisioNode.cls

@@ -0,0 +1,22 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "VisioNode"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'------------ Payload for Hierarchy node ---------------
+Option Explicit
+
+Public type_ As TItem
+Public position_ As TSubjectType
+Public text_ As String
+Public shape_ As Visio.Shape
+
+Public Function Init(nType As TItem, sText$, Optional nPosition As TSubjectType = T_SUBJECT_UNKNOWN)
+  type_ = nType
+  text_ = sText
+  position_ = nPosition
+End Function

src/z_UIMessages.bas

@@ -0,0 +1,68 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_XL_INVALID_TYPE = ERR_XL_INVALID_TYPE
+  EM_VALIDATION_FAIL
+  EM_DATA_EMPTY
+  EM_INVALID_FILE_FORMAT
+    
+  IM_GENERATION_OK
+
+ ' QM_CLEAR_BEFORE_READD
+End Enum
+
+Private g_UI As API_UserInteraction
+
+Public Function UserInteraction() As API_UserInteraction
+  If g_UI Is Nothing Then _
+    Set g_UI = New API_UserInteraction
+  Set UserInteraction = g_UI
+End Function
+
+Public Function SetUserInteraction(newUI As API_UserInteraction)
+  Set g_UI = newUI
+End Function
+
+Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Select Case theCode
+  Case EM_VALIDATION_FAIL
+    Call MsgBox("Çàïîëíèòå âñå ïîëÿ", vbExclamation)
+  Case EM_DATA_EMPTY
+    Call MsgBox("Data is empty", vbExclamation)
+  Case EM_INVALID_FILE_FORMAT
+    Call MsgBox("Invalid file format", vbExclamation)
+  Case EM_XL_INVALID_TYPE
+    Call MsgBox(Fmt("Íå îïðåäåëåí òèï óçëà íà ñòðîêå {1}", params), vbExclamation)
+    
+  Case IM_GENERATION_OK
+    Call MsgBox(Fmt("Generation complete" & vbNewLine & _
+                    "Elements count: {1}" & vbNewLine & _
+                    "Page size: {2} x {3} mm^2", unwrapped), vbInformation)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+ ' Case QM_CLEAR_BEFORE_READD
+  '  answer = MsgBox("Äàííûé äîêóìåíò óæå äîáàâëåí â áàçó. Óäàëèòü âñå åãî äàííûå ïåðåä îáíîâëåíèåì?", vbYesNo + vbQuestion)
+        
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/z_UIRibbon.bas

@@ -0,0 +1,10 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+
+Public Sub OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+    Case "LoadExcel":        Call RunGenerator
+    Case "ClearMain":        Call ClearMain
+    Case "DeletePages":        Call DeleteAllPages
+  End Select
+End Sub

ui/.rels

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId3" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/thumbnail" Target="docProps/thumbnail.emf"/><Relationship Id="rId2" Type="http://schemas.microsoft.com/office/2007/relationships/ui/extensibility" Target="visio/customUI/customUI1.xml"/><Relationship Id="rId1" Type="http://schemas.microsoft.com/visio/2010/relationships/document" Target="visio/document.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties" Target="docProps/custom.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId4" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/></Relationships>

ui/customUI1.xml

@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
+<ribbon>
+	<tabs>
+	<tab id="tab1" label="КАРТА СУБЪЕКТОВ">
+	<group id="group1" label="Загрузка">
+		<button id="LoadExcel" size="large"
+			label="Импорт"
+			supertip="Загрузка из Excel"
+			imageMso="FileSaveAsExcelXlsx" 
+			onAction="OnRibbonBtn"/>
+		<button id="ClearMain" size="large"
+			label="Очистка"
+			supertip="Очистить основной лист"
+			imageMso="AccessRecycleBin"
+			onAction="OnRibbonBtn"/>
+		<button id="DeletePages" size="large"
+			label="Удалить страницы"
+			supertip="Удалить все дополнительные страницы"
+			imageMso="BroadcastEnd"
+			onAction="OnRibbonBtn"/>
+	</group>
+	</tab>
+	</tabs>
+</ribbon>
+</customUI>