在 Powerpoint 上的固定位置之间同时进行多形状旋转答案

【问题标题】：Simultaneous many-shape rotation between fixed positions on Powerpoint在 Powerpoint 上的固定位置之间同时进行多形状旋转
【发布时间】：2020-09-29 17:13:04
【问题描述】：

我有六个对象，都在一个给定的固定位置，如下图所示

文本框都具有相同的大小。我想自动化所有文本框的逆时针旋转，这样当我使用宏时，它会将文本旋转 60º ccw（因此 BETA 变为 ALPHA，ALPHA 变为 ZETA 等等）。但是，我完全不知道如何在 VBA 中编写它！我知道我可以使用

设置文本框

Set myDocument = ActivePresentation.Slides(1) 
myDocument.Shapes.AddTextbox(Type:=msoTextOrientationHorizontal, _ 
    Left:=400, Top:=100, Width:=160, Height:=30).TextFrame _ 
    .TextRange.Text = "ALPHA"

但是，我对如何旋转它们一无所知。另一种选择是创建这六个文本框并创建一个只更改文本变量的函数，但我的 VBA 知识非常初级，我什至不知道从哪里开始：\

谁能帮我一个小忙？

【问题讨论】：

标签： vba textbox powerpoint

【解决方案1】：

如果你的意思是旋转他们的位置而不是他们的方向，它可能看起来像这样：

Option Explicit

Public Sub ExampleRotatePositions()
    Dim myDocument As Slide
    Set myDocument = ActivePresentation.Slides(1)

    Dim TextBox(1 To 6) As Shape

    'create the textboxes in your desired position.
    Set TextBox(1) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=100, Width:=160, Height:=30)
    TextBox(1).TextFrame.TextRange.Text = "ALPHA"

    Set TextBox(2) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=200, Top:=100, Width:=160, Height:=30)
    TextBox(2).TextFrame.TextRange.Text = "BETA"

    Set TextBox(3) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=300, Top:=100, Width:=160, Height:=30)
    TextBox(3).TextFrame.TextRange.Text = "GAMMA"

    Set TextBox(4) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=400, Top:=100, Width:=160, Height:=30)
    TextBox(4).TextFrame.TextRange.Text = "DELTA"

    Set TextBox(5) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=500, Top:=100, Width:=160, Height:=30)
    TextBox(5).TextFrame.TextRange.Text = "EPSILON"

    Set TextBox(6) = myDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=600, Top:=100, Width:=160, Height:=30)
    TextBox(6).TextFrame.TextRange.Text = "ZETA"

    MsgBox "Start rotating now"


    'remember last position
    Dim LastLeft As Single
    LastLeft = TextBox(UBound(TextBox)).Left
    Dim LastTop As Single
    LastTop = TextBox(UBound(TextBox)).Top

    'rotate position
    Dim iTextBox As Long
    For iTextBox = UBound(TextBox) - 1 To LBound(TextBox) Step -1
        TextBox(iTextBox + 1).Left = TextBox(iTextBox).Left
        TextBox(iTextBox + 1).Top = TextBox(iTextBox).Top
    Next iTextBox

    'move first to last position
    TextBox(LBound(TextBox)).Left = LastLeft
    TextBox(LBound(TextBox)).Top = LastTop
End Sub

【讨论】：

【解决方案2】：

使用ShapeRange.Group method 对它们进行分组，然后旋转该组：

Set myDocument = ActivePresentation.Slides(1)

With myDocument.Shapes   
    .AddShape(msoShapeCan, 50, 10, 100, 200).Name = "shpOne"
    .AddShape(msoShapeCube, 150, 250, 100, 200).Name = "shpTwo"

    With .Range(Array("shpOne", "shpTwo")).Group
        .Fill.PresetTextured msoTextureBlueTissuePaper
        .Rotation = 45
        .ZOrder msoSendToBack
    End With
End With

【讨论】：

这行不通，因为您将考虑旋转整个组（即，形状固定在组的框架内）。最后，你会得到不同位置的对象，是的，但不尊重原始方向。此外，代码不允许对象进一步旋转...
@Strelok 好吧，您的问题并不清楚。您的意思不是旋转（方向的含义），而是旋转位置的含义。我为此写了另一个答案。