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

Question

我有六个物体，都在一个给定的固定位置，如下图所示。

文本框的大小都是一样的。我想自动将所有文本框逆时针旋转，这样当我使用宏时，它会将文本旋转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"

但是，我对如何旋转它们毫无头绪。另一种选择是创建这六个TextBoxes，然后创建一个只改变文本变量的函数，但是，我的VBA知识很初级，我都不知道从哪里开始:。

谁能给我一个小小的帮助？

Answer 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

Answer 2

用以下方法对它们进行分组 ShapeRange.Group方法 然后再轮换组。

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