PDA

View Full Version : need help for code to work like timer



elsuji
12-05-2020, 12:15 PM
​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

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.

elsuji
12-08-2020, 09:16 AM
Dear Team,

any one please help me to solve my above requirement

elsuji
12-13-2020, 04:52 AM
Team,

Need your help