Question

我正在尝试创建一个简单的PowerPoint文件来捕获项目组合的一系列里程碑。我创建了以下宏来创建里程碑视觉效果并将形状分组。但是，我希望创建另一个宏来更新/状态里程碑。具体来说，我希望用户选择组，然后运行宏，以允许用户更新日期并相应地移动形状，或者，如果任务完成，请填写形状。

我努力启动更新宏来识别形状及其内容以完成计算。例如，我不知道如何在日期中读取根据新日期左/右移动里程碑。任何帮助表示赞赏！

代码：

Private Sub EnterTask_Click()

Dim Sld As Slide
Dim shapeMile As Shape
Dim shapeTask As Shape
Dim shapeECD As Shape
Dim dateECD As String
Dim taskText As String

Dim StatusBox As Shape

dateECD = "6/12/18"
taskText = "Task #1"

Set Sld = Application.ActiveWindow.View.Slide

With Sld

'Create shape with Specified Dimensions and Slide Position
Set shapeMile = Sld.Shapes.AddShape(Type:=msoShapeIsoscelesTriangle, _
    Left:=25, Top:=150, Width:=15, Height:=15)

    With shapeMile
        .Rotation = 180
        .Tags.Add "Milestone", "Bug"
        .Line.Visible = msoTrue
        .Fill.Visible = msoFalse
        .Shadow.Visible = msoFalse

    End With

Set shapeECD = Sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    Left:=8, Top:=165, Width:=50, Height:=30)

    With shapeECD
        .Tags.Add "Milestone", "ECD"
        .Line.Visible = msoFalse
        .Fill.Visible = msoFalse
        .Shadow.Visible = msoFalse
        .TextFrame.TextRange.Characters.Text = dateECD
        .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
        .TextFrame.VerticalAnchor = msoAnchorTop
        .TextFrame.HorizontalAnchor = msoAnchorCenter
        .TextFrame.TextRange.Font.Size = 8
        .TextFrame.TextRange.Font.Name = "Arial"
        .TextFrame.TextRange.Font.Italic = msoFalse
        .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
    End With

Set shapeTask = Sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    Left:=8, Top:=135, Width:=50, Height:=30)

    With shapeTask
        .Tags.Add "Milestone", "Task"
        .Line.Visible = msoFalse
        .Fill.Visible = msoFalse
        .Shadow.Visible = msoFalse
        .TextFrame.TextRange.Characters.Text = taskText
        .TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
        .TextFrame.VerticalAnchor = msoAnchorTop
        .TextFrame.HorizontalAnchor = msoAnchorCenter
        .TextFrame.TextRange.Font.Size = 8
        .TextFrame.TextRange.Font.Name = "Arial"
        .TextFrame.TextRange.Font.Italic = msoFalse
        .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
    End With

.Shapes.Range(Array(shapeMile.Name, shapeECD.Name, shapeTask.Name)).Group

End With

End Sub

PowerPoint VBA识别分组中的形状

0 个答案: