在 MS Visio 中更改文本形状位置

Question

我有示意图，其中 Visio 文本（由线性形状组成）放置错误。它不是在中间，而是在右边。

我想让它们全部居中。

因为我是 VBA Visio 的新手，所以我录制了一个宏来解决这些情况下的基本代码属性。

我的 VBA 代码指出，每个形状都有自己的 ID，很难将其与其他点形状区分开来。 因为我已经通过使用这个线程定义了我的目标所需的形状 ID 范围，所以我已经完成了很多工作：

https://learn.microsoft.com/en-us/office/client-developer/visio/change-the-name-and-view-the-id-of-a-shape

我决定只对这些 ID 高于特定值的形状使用代码。不幸的是以下代码：

Sub SLDalter()
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

Dim UndoScope As Long
UndoScope = Application.BeginUndoScope("Modify Control")

With Application.ActiveWindow.Page.Shapes.ItemFromID(>1104)
.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.6"
.CellsSRC(visSectionControls, 0, visCtlY).FormulaU = "Height*1"
End With

结束子

没用。

我还尝试了其他解决方案，例如：

http://visguy.com/vgforum/index.php?topic=887.0

https://bvisual.net/2021/01/02/referencing-visio-shapes/

但他们也没有用。

如何在 Visio 中使用简单的 VBA 代码进行批量文本移动？

Answer 1

请试试这个代码

Sub bbb()
Dim sl As Selection, ShpObj As Shape, vl As Single
Set sl = ActivePage.CreateSelection(visSelTypeByLayer, , "Connector") ' create selection from 'Connector' layer
For Each ShpObj In sl ' iterate items in selection
    vl = ShpObj.CellsSRC(visSectionControls, 0, visCtlX) - 1 ' get X text position coordinate to left per inch
    ShpObj.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = Chr(34) & vl & Chr(34) ' move text position
Next
End Sub

这段代码在我这边是如何工作的。