将形状对齐以具有一致的Visio VBA边缘

Question

过去，我主要是在excel上使用VBA，但是我经验不足。

我想循环显示多个框，并使每个框的边缘重合。就像他们坐在彼此的顶部。我在确定选择中第一个形状的位置时遇到麻烦。我尝试了许多不同的对象，包括selection.shaperange。

    Dim shp As Visio.Shape
    Dim shp1 As Visio.Shape
    Dim Pos As Double
    Set shp1 = ActiveWindow.Selection.ShapeRange.Item
    Pos = shp1.Cells("PinY")

    For Each shp In Application.ActiveWindow.Selection
            'Change the cell name to the one you want
        If shp <> ActiveWindow.Selection.Item(1) Then
            Pos = Pos + 6
        End If

        shp.CellsSRC(visSectionControls, visRowXFormOut, visXFormPinY).FormulaU = Pos & "mm"
        Pos = shp.Cells("PinY")
    Next shp
End Sub

您能帮我得到第一个选定项目的位置，然后我可能可以找出其余的项目。

Answer 1

此代码将邻接除第一个选定形状之外的所有形状的左侧和第一个选定形状的右侧：

Option Explicit

Public Sub AbutLeftsToPrimaryRight()

  Dim sel As Visio.Selection
  Set sel = Visio.ActiveWindow.Selection

  If (sel.Count < 2) Then
    Debug.Print "Select two or more shapes (Use Shift + Click)!"
    GoTo Cleanup
  End If

  Dim shp0 As Visio.Shape
  Dim shp As Visio.Shape

  '// Get the selection and the primary selected shape,
  '// which is item(1). See also: Selection.PrimaryItem
  Set shp0 = sel(1)

  '// Quick calculate the right side of shp0:
  '// PinX - LocPinX + Width.
  Dim dRight0 As Double
  dRight0 = shp0.CellsU("PinX").ResultIU - shp0.CellsU("LocPinX").ResultIU + shp0.CellsU("Width").ResultIU

  '// If shapes are rotated, flipped, or not rectangular,
  '// then you'll need to use shp.BoundingBox, which
  '// is more complicated

  Dim dLeft As Double
  Dim dx As Double, px As Double
  Dim i As Integer
  For i = 2 To sel.Count

    '// Get the ith shape:
    Set shp = sel(i)

    '// Get its Pin:
    px = shp.CellsU("PinX").ResultIU

    '// Calculate the left side of the shape:
    '// PinX - LocPinX:
    dLeft = px - shp.CellsU("LocPinX").ResultIU

    '// The offset:
    dx = dLeft - dRight0

    '// Set the new pin:
    shp.CellsU("PinX").ResultIUForce = px - dx

  Next i

Cleanup:
  Set shp0 = Nothing
  Set shp = Nothing
  Set sel = Nothing
End Sub

希望这会有所帮助！