Surrogate-TM

for each sh in sheets: sh.Columns("A:A").EntireColumn.AutoFit: next

Surrogate-TM

Fix blind guide-lines in MS Visio 2013+

Originally posted at https://visio.getbb.ru/viewtopic.php?p=11302#p11302
The guide lines in versions after 2013 are barely visible, this code makes the lines visible.

sub ChangeGuideStyle()
Dim App
dim Doc, pg
Dim i, sh
dim Nam

Surrogate-TM

Repair Error #1 in MS Visio

Originally posted at https://visio.getbb.ru/viewtopic.php?p=4885#p4885

Sub vsd_RepairError1()
dim fso ' определяем переменную fso объект файловой системы
dim fil ' определяем переменную fil файл
Dim nn as string ' определяем переменную nn - имя нового файла в формате vdx
Dim sn as string ' определяем переменную sn - полное имя редактируемого файла
Dim pth as string ' определяем переменную pth - путь к папке где лежит редактируемый файл
Dim fn as string ' определяем переменную fn - имя редактируемого файла

Surrogate-TM

Код опубликован в ветке обсуждения https://visio.getbb.ru/viewtopic.php?p=16847#p16847

Sub FindNumberInText()
Dim shp As Shape ' переменная текущая фигура
Dim dl As Integer ' переменная длина текстового блока текущей фигуры
Dim symb As String ' текущий символ
Dim sn As Integer ' ASCII-код текущего символа
Dim cr As String ' числовая последовательность в текстовом блоке
Dim st As Integer ' начальная позиция числовой последовательности в текстовом блоке
Dim lng As Integer ' количество символо числовой последовательности в текстовом блоке

Surrogate-TM

import win32com.client as win32
vApp = win32.gencache.EnsureDispatch('Visio.Application')
vWin = vApp.ActiveWindow
shp = vWin.Selection.PrimaryItem
cp = shp.Name
print(cp)
shp.Cells('Width').FormulaU = '7 mm'
shp.Cells('Height').FormulaU = '40 mm'
shp.Cells('Angle').FormulaU = '0 deg'
shp.Cells('PinX').FormulaU = '60 mm'

Surrogate-TM

Toggle Format Shape Pane

I have always been annoyed by the additional Format Shape panel:

1. Takes up a lot of space on the screen
2. It is easy to call with the button on the ribbon or the F3 button, but there is no way to minimize it.
   I have to move the mouse across the screen and click the x cross button to close it!
   

Sub ToggleFormatShapePane() 
Dim cmbr As CommandBar

Surrogate-TM

Enumerating Visio CommandBars

This macro lists all the CommandBars and Controls in Visio

Sub VisioCommandBars()
Dim ap As Application
Set ap = Application
Dim cmbr1 As CommandBar
Dim cnt1 As CommandBarControl
For i = 1 To Application.CommandBars.Count
Set cmbr1 = Application.CommandBars(i)

Surrogate-TM

Modern enumerations

MS Office
MS Word
MS Visio
MS Excel

Old enumerations

MS Official resource

MS Word 2003

Unofficial resources

• dic.rdy.jp

Surrogate-TM

Метод XYToPage

Метод XYToPage - позволяет преобразовать относительные координаты элемента фигуры [вершины/точки соединения/управляемые точки(контрола)] в абсолютные координаты страницы.

Немного теории

Давайте рассмотрим пример определения координат управляемой точки. Речь идет о точке желтого цвета, она же точка привязки текста фигуры.

Координаты элементов внутри фигуры всегда локальные, точкой отсчета является левый нижний угол фигуры!
Координата этой точки осчета фигуры состоит из двух составляющих:

• PinX/PinY - абсолютная координата Положения булавки (подробнее о Положении булавки)
• LocPinX/LocPinY - относительное Положение булавки внутри фигуры

Surrogate-TM

Нижеприведенный код всего около 40 строк, добавляет соединительной линии возможность изменять цвета фигур к ней присоединенных.

Обычному пользователю это кажется фантастикой…
Данная магия достигается с использованием событий объекта Application.

Private WithEvents vsoApplication As Visio.Application  ' переменная связанная с событиями
 Public Sub start() ' процедура запуска режима перекраски
  Set vsoApplication = Application ' определяем переменную связанную с событиями
 End Sub