1 Attachment(s)
need help for code to work like timer
Dear Team,
I created code for rotating the shape. I am having two line ( L1 & L2) and ON/OFF button.
When I press the button to ON condition my L1 (Line 1, Line 2 & Line 3) color will change to red and Line 2 angle change to 0deg and also Motor is rotating at 0.02 ratio.
At present the above condition is working properly.
But i want once it is started, after 3 second L1 go to black color and L2 shout change to red color and the motor should rotate at 0.05 ratio.
My code is
Code:
Sub TEST()
Dim shp As Shape, ShpArrRot
Set shp = ActivePresentation.Slides(1).Shapes("Button")
ShpArrRot = Array("Motor")
With shp
If .TextFrame.TextRange.Text = "ON" Then
.Fill.ForeColor.RGB = vbRed
.TextFrame.TextRange.Text = "OFF"
.TextFrame.TextRange.Font.Bold = True
ActivePresentation.Slides(1).Shapes("Line1").Line.ForeColor.RGB = vbBlack
ActivePresentation.Slides(1).Shapes("Line2").Line.ForeColor.RGB = vbBlack
ActivePresentation.Slides(1).Shapes("Line2").IncrementRotation -45
ActivePresentation.Slides(1).Shapes("Line3").Line.ForeColor.RGB = vbBlack
ActivePresentation.Slides(1).Shapes("Line4").Line.ForeColor.RGB = vbBlack
ActivePresentation.Slides(1).Shapes("Line5").Line.ForeColor.RGB = vbBlack
ActivePresentation.Slides(1).Shapes("Line5").IncrementRotation -45
ActivePresentation.Slides(1).Shapes("Line6").Line.ForeColor.RGB = vbBlack
ElseIf .TextFrame.TextRange.Text = "OFF" Then
.Fill.ForeColor.RGB = vbGreen
.TextFrame.TextRange.Text = "ON"
.TextFrame.TextRange.Font.Bold = True
ActivePresentation.Slides(1).Shapes("Line1").Line.ForeColor.RGB = vbRed
ActivePresentation.Slides(1).Shapes("Line2").Line.ForeColor.RGB = vbRed
ActivePresentation.Slides(1).Shapes("Line2").IncrementRotation 45
ActivePresentation.Slides(1).Shapes("Line3").Line.ForeColor.RGB = vbRed
End If
' Minimum & maximum angles in degrees
Const MinAngle& = 0, MaxAngle& = 360
' Define the rotation ratio from 0 up to 1
Dim phi&, Ratio#, t!
' Rotate shape
With ActivePresentation.Slides(1).Shapes(ShpArrRot(x))
Ratio = 0
Do
' Rotate clockwise
Ratio = Ratio + 0.02
If ActivePresentation.Slides(1).Shapes("Button").TextFrame.TextRange.Text = "OFF" Then Exit Do
' Calc the rotation angle in degrees
phi = (MinAngle + (MaxAngle - MinAngle) * Ratio) Mod 360
Debug.Print "phi = "; phi
' Rotate shape
.Rotation = phi
' Make pause
t = Timer + 0.01: While Timer < t: DoEvents: Wend
Loop While True
End With
End With
End Sub
Can any one please help me how to do this. I am attaching my file here for your reference.
