Consulting

Results 1 to 3 of 3

Thread: need help for code to work like timer

  1. #1
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location

    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
    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.
    Attached Files Attached Files

  2. #2
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Team,

    any one please help me to solve my above requirement

  3. #3
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Team,

    Need your help

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •