-
Run the following codes.
-
Start Power Point slide show in order to see what the the following codes are doing.
-
Why Red Rectangles height does not fit Blue Rectangles height?
-
Please click this link in order to see my question
Public RectangleHeight As Double Public BreakHeight As Double Public Sub Macro1() 'Test if PowerPoint settings are appropriate for testing the following macros If ActivePresentation.PageSetup.SlideWidth <> 960 Then MsgBox "PowerPoint settings are not appropriate" If ActivePresentation.PageSetup.SlideHeight <> 540 Then MsgBox "PowerPoint settings are not appropriate" 'Delete all slides For i = ActivePresentation.Slides.Count To 1 Step -1 ActivePresentation.Slides(i).Delete Next i 'Add a blank slide ActivePresentation.Slides.Add index:=1, Layout:=ppLayoutBlank ActivePresentation.Slides(1).FollowMasterBackground = False 'Declaration RectangleHeight = 19.1 BreakHeight = 2 Call Macro2 End Sub Public Sub Macro2() 'Add 20 Blue Rectangles For i = 1 To 20 With ActivePresentation.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=100, Top:=0, Width:=400, Height:=19.1) .Name = "BlueRectangle" & i .Line.Visible = msoFalse .Fill.ForeColor.RGB = vbBlue .TextFrame2.TextRange.Text = i .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft If i = 1 Then .Top = 120 If i = 2 Then .Top = ((RectangleHeight + BreakHeight) * 1) + 120 If i = 3 Then .Top = ((RectangleHeight + BreakHeight) * 2) + 120 If i = 4 Then .Top = ((RectangleHeight + BreakHeight) * 3) + 120 If i = 5 Then .Top = ((RectangleHeight + BreakHeight) * 4) + 120 If i = 6 Then .Top = ((RectangleHeight + BreakHeight) * 5) + 120 If i = 7 Then .Top = ((RectangleHeight + BreakHeight) * 6) + 120 If i = 8 Then .Top = ((RectangleHeight + BreakHeight) * 7) + 120 If i = 9 Then .Top = ((RectangleHeight + BreakHeight) * 8) + 120 If i = 10 Then .Top = ((RectangleHeight + BreakHeight) * 9) + 120 If i = 11 Then .Top = ((RectangleHeight + BreakHeight) * 10) + 120 If i = 12 Then .Top = ((RectangleHeight + BreakHeight) * 11) + 120 If i = 13 Then .Top = ((RectangleHeight + BreakHeight) * 12) + 120 If i = 14 Then .Top = ((RectangleHeight + BreakHeight) * 13) + 120 If i = 15 Then .Top = ((RectangleHeight + BreakHeight) * 14) + 120 If i = 16 Then .Top = ((RectangleHeight + BreakHeight) * 15) + 120 If i = 17 Then .Top = ((RectangleHeight + BreakHeight) * 16) + 120 If i = 18 Then .Top = ((RectangleHeight + BreakHeight) * 17) + 120 If i = 19 Then .Top = ((RectangleHeight + BreakHeight) * 18) + 120 If i = 20 Then .Top = ((RectangleHeight + BreakHeight) * 19) + 120 End With Next i Call Macro3 End Sub Public Sub Macro3() 'Add 20 Red Rectangles For i = 1 To 20 With ActivePresentation.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=200, Top:=0, Width:=200, Height:=19.1) .Name = "RedRectangle" & i .Line.Visible = msoFalse .Fill.ForeColor.RGB = vbRed .TextFrame2.TextRange.Text = i .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft If i = 1 Then .Top = 120 If i = 2 Then .Top = ((RectangleHeight + BreakHeight) * 1) + 120 If i = 3 Then .Top = ((RectangleHeight + BreakHeight) * 2) + 120 If i = 4 Then .Top = ((RectangleHeight + BreakHeight) * 3) + 120 If i = 5 Then .Top = ((RectangleHeight + BreakHeight) * 4) + 120 If i = 6 Then .Top = ((RectangleHeight + BreakHeight) * 5) + 120 If i = 7 Then .Top = ((RectangleHeight + BreakHeight) * 6) + 120 If i = 8 Then .Top = ((RectangleHeight + BreakHeight) * 7) + 120 If i = 9 Then .Top = ((RectangleHeight + BreakHeight) * 8) + 120 If i = 10 Then .Top = ((RectangleHeight + BreakHeight) * 9) + 120 If i = 11 Then .Top = ((RectangleHeight + BreakHeight) * 10) + 120 If i = 12 Then .Top = ((RectangleHeight + BreakHeight) * 11) + 120 If i = 13 Then .Top = ((RectangleHeight + BreakHeight) * 12) + 120 If i = 14 Then .Top = ((RectangleHeight + BreakHeight) * 13) + 120 If i = 15 Then .Top = ((RectangleHeight + BreakHeight) * 14) + 120 If i = 16 Then .Top = ((RectangleHeight + BreakHeight) * 15) + 120 If i = 17 Then .Top = ((RectangleHeight + BreakHeight) * 16) + 120 If i = 18 Then .Top = ((RectangleHeight + BreakHeight) * 17) + 120 If i = 19 Then .Top = ((RectangleHeight + BreakHeight) * 18) + 120 If i = 20 Then .Top = ((RectangleHeight + BreakHeight) * 19) + 120 End With Next i Call Macro4 End Sub Public Sub Macro4() 'Add motion effect (motion animation) to 20 Red Rectangles. Dim myDouble As Double myDouble = (RectangleHeight + BreakHeight) / ActivePresentation.PageSetup.SlideHeight * 100 Debug.Print myDouble '3.90740740740741 For i = 1 To 20 With ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(Shape:=ActivePresentation.Slides(1).Shapes("RedRectangle" & i), EffectId:=msoAnimEffectCustom) With .Behaviors.Add(msoAnimTypeMotion) .MotionEffect.FromX = 0 .MotionEffect.ToX = 0 .MotionEffect.FromY = 0 If i = 1 Then .MotionEffect.ToY = 3.90740740740741 'myDouble * 1 If i = 2 Then .MotionEffect.ToY = -3.90740740740741 'myDouble * -1 If i = 3 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 4 Then .MotionEffect.ToY = -3.90740740740741 'myDouble * -1 If i = 5 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 6 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 7 Then .MotionEffect.ToY = -11.7222222222222 'myDouble * -3 If i = 8 Then .MotionEffect.ToY = -11.7222222222222 'myDouble * -3 If i = 9 Then .MotionEffect.ToY = 7.81481481481481 'myDouble * 2 If i = 10 Then .MotionEffect.ToY = 19.537037037037 'myDouble * 5 If i = 11 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 12 Then .MotionEffect.ToY = -19.537037037037 'myDouble * -5 If i = 13 Then .MotionEffect.ToY = -3.90740740740741 'myDouble * -1 If i = 14 Then .MotionEffect.ToY = -3.90740740740741 'myDouble * -1 If i = 15 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 16 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 17 Then .MotionEffect.ToY = 11.7222222222222 'myDouble * 3 If i = 18 Then .MotionEffect.ToY = -3.90740740740741 'myDouble * -1 If i = 19 Then .MotionEffect.ToY = -11.7222222222222 'myDouble * -3 If i = 20 Then .MotionEffect.ToY = -39.0740740740741 'myDouble * -10 Debug.Print VarType(.MotionEffect.ToY) '4=vbSingle Debug.Print .MotionEffect.ToY '3,907408 '-3,907408 '11,72222 '-3,907408 '11,72222 '11,72222 '-11,72222 '-11,72222 '7,814815 '19,53704 '11,72222 '-19,53704 '-3,907408 '-3,907408 '11,72222 '11,72222 '11,72222 '-3,907408 '-11,72222 '-39,07407 End With .Timing.Duration = 2 .Timing.TriggerDelayTime = 1 .Timing.TriggerType = msoAnimTriggerWithPrevious End With Next i End Sub
It looks like your post is mostly code; please add some more details.
It looks like your post is mostly code; please add some more details.
It looks like your post is mostly code; please add some more details.
It looks like your post is mostly code; please add some more details.
It looks like your post is mostly code; please add some more details.