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
    Last edited by Aussiebear; 03-06-2025 at 07:35 PM.

  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
  •