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"

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

谁能帮我个小忙？

Answer 1

使用 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

Answer 2

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

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

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

Simultaneous many-shape rotation between fixed positions on Powerpoint

powerpoint

vba

textbox