привязать узел к сетке в PowerPoint - PullRequest
0 голосов
/ 27 мая 2018

В Powerpoint, при создании или редактировании формы произвольной формы, невозможно привязать узлы к сетке.Чтобы решить эту проблему, я написал макрос для привязки узлов выбранной фигуры к сетке:

Dim oShp As Shape
Dim NodeIndex As Integer
Dim GD, pWidth, pHeight, currxValue, curryValue, xOffset, yOffset As Single

If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub
If Not ActiveWindow.Selection.ShapeRange.Count = 1 Then Exit Sub
If Not ActiveWindow.Selection.ShapeRange.Type = msoFreeform Then Exit Sub

Set oShp = ActiveWindow.Selection.ShapeRange(1)

GD = ActivePresentation.GridDistance
pWidth = ActivePresentation.PageSetup.SlideWidth
pHeight = ActivePresentation.PageSetup.SlideHeight

With oShp
    For NodeIndex = .Nodes.Count To 1 Step -1
        pointsArray = .Nodes.Item(NodeIndex).Points
        currxValue = pointsArray(1, 1)
        curryValue = pointsArray(1, 2)
        xOffset = (pWidth / 2) - (Int((pWidth / 2) / GD) * GD)
        yOffset = (pHeight / 2) - (Int((pHeight / 2) / GD) * GD)
        .Nodes.SetPosition Index:=NodeIndex, _
            X1:=Round((currxValue - xOffset) / GD) * GD + xOffset, _
            Y1:=Round((curryValue - yOffset) / GD) * GD + yOffset
    Next

End With

Моя проблема в том, что для фигуры свободной формы с более чем 30 узлами макрос начинает работатьочень медленно.Если форма содержит еще больше узлов, PowerPoint зависает на некоторое время, а затем макрос завершается ошибкой.

Буду очень признателен, если кто-нибудь увидит, что я сделал неправильно или что можно улучшить / оптимизировать.

Большое спасибо и наилучшие пожелания.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...