I am trying to create a simple PowerPoint file to capture a series of milestones for a project portfolio. I have created the following Macro to create the milestone visual and group the shapes. However, I am looking to create another macro for updating/statusing the milestone. Specifically, I want the user to select the group and then run a macro to that will allow the user to update the date and move the shapes accordingly or, if the task is complete, fill in the shape.
I struggle with the initiation of the update macro to identify the shapes and its' content to complete the calculation. For example, I don't know how to read in the date in to move the milestone left/right based on the new date. Any help is appreciated!
Code:
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