Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 21

Thread: Pause the program

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

    Pause the program

    Dear Team,

    I am new for this power point coding.

    I had create code for pause the program and execute after 2 seconds in excel and it is working greate.
    My excel code is
    Sub MCI55_PUSH_BUTTON()Dim shp As Shape, shpArrOnOff, shpArrOnOff1, shpArrColor, i As Long, i1 As Long, j As Long, j1 As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Additional")
    Set shp = ActiveSheet.Shapes("P-BUTTON")
    shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
    shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
    shpArrOnOff = Array("RedClr31")
    shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
     With shp
     If ActiveSheet.Shapes("MCCB-ON-OFF").TextFrame.Characters.Text = "ON" _
    And ActiveSheet.Shapes("P-BUTTON").TextFrame.Characters.Text = "OFF" Then
     .Fill.ForeColor.RGB = vbGreen
     .TextFrame.Characters.Text = "ON"
     .TextFrame.Characters.Font.Bold = True
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActiveSheet.Shapes(shpArrOnOff(i)).IncrementRotation 30
    
    
     Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActiveSheet.Shapes("MCCB-ON-OFF").TextFrame.Characters.Text = "ON" _
                And ActiveSheet.Shapes("P-BUTTON").TextFrame.Characters.Text = "ON" Then
                    ActiveSheet.Shapes(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActiveSheet.Shapes(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ws.Shapes("P-BUTTON").TextFrame.Characters.Text = "ON" Then
                    ActiveSheet.Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActiveSheet.Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
                
     Call PauseIt
     Application.Wait (Now() + TimeValue("0:00:01"))
    
    
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActiveSheet.Shapes(shpArrOnOff(i)).IncrementRotation -30
     Next i
     
                 For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActiveSheet.Shapes(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActiveSheet.Shapes(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
    
     End If
     End With
    End Sub
    Sub PauseIt()
     'Application.Wait (Now() + TimeValue("0:00:00"))
    End Sub
    The i modified the excel code as per power point. But pause condition is not working
    My power point code is

    Sub MCI55_PUSH_BUTTON()Dim shp As Shape, shpArrOnOff, shpArrOnOff1, shpArrColor, shpArrColor1, i As Long, i1 As Long, j As Long, j1 As Long
    
    
    
    
    Set shp = ActivePresentation.Slides(3).Shapes("P-BUTTON")
    shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
    shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
    shpArrOnOff = Array("RedClr31")
    shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
     With shp
     If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
    And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "OFF" Then
     .Fill.ForeColor.RGB = vbGreen
     .TextFrame.TextRange.Text = "ON"
     .TextFrame.TextRange.Font.Bold = True
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation 30
    
    
     Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(3).Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
    
    
     Call PauseIt
     Application.WAIT (Now() + TimeValue("0:00:01"))
    
    
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
     Next i
    
    
                 For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
     End If
     End With
    End Sub
    Sub PauseIt()
     Application.WAIT (Now() + TimeValue("0:00:00"))
    End Sub
    when i am running above code i am getting "Method or Data member not found" error message.

    Can any one help me to correct this issue

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    PP doesn't have a .Wait

    Try using Sleep instead

    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    ...
    ...
    ...
    
    Sleep 1000    ' for a one second delay
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    I tried sleep function. But it is not working as per my requirement.

    My requirement is

    Fit it should execute the following
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Sub MCI55_PUSH_BUTTON()Dim shp As Shape, shpArrOnOff, shpArrOnOff1, shpArrColor, shpArrColor1, i As Long, i1 As Long, j As Long, j1 As Long
    
    
    
    
    Set shp = ActivePresentation.Slides(3).Shapes("P-BUTTON")
    shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
    shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
    shpArrOnOff = Array("RedClr31")
    shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
     With shp
     If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
    And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "OFF" Then
     .Fill.ForeColor.RGB = vbGreen
     .TextFrame.TextRange.Text = "ON"
     .TextFrame.TextRange.Font.Bold = True
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation 30
     Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(3).Shapes("1F1").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(3).Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
    Then it will wait for 2sec and after 2sec it should execute the following

    Sleep 2000
    
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
     Next i
    
    
                 For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
    
     End If
     End With
    End Sub
    Can you please check and confirm the code

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Attach a small presentation that we can play with
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Mr. Paul,

    I had attached my file here for your reference. For your easy understand i marked yellow border on my slide
    Attached Files Attached Files

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    1. The usual PP way to define a macro to run when clicking a shape is

    Sub MCI55_PUSH_BUTTON(shp As Shape)
    The clicked shape gets passed in the call

    2. I made a small driver program to step through

    Sub drv()
        Call MCI55_PUSH_BUTTON(ActivePresentation.Slides(3).Shapes("P-BUTTON"))
    End Sub
    3. As written the red was = "ON" and = "OFF"

    Stepping through the AND was false and nothing, including the Sleep, was never executed

    Temporilarly changing

    ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "OFF"


    then the If/Then was executed, including the Sleep

    Capture.JPG


    Sub MCI55_PUSH_BUTTON(shp As Shape)
    
    
    Dim shpArrOnOff, shpArrOnOff1, shpArrColor, shpArrColor1, i As Long, i1 As Long, j As Long, j1 As Long
    
    
    '   Set shp = ActivePresentation.Slides(3).Shapes("P-BUTTON")
        
        shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
        shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
        shpArrOnOff = Array("RedClr31")
        shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
         
        With shp
           If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "OFF" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "OFF" Then
                
                .Fill.ForeColor.RGB = vbGreen
                .TextFrame.TextRange.Text = "ON"
                .TextFrame.TextRange.Font.Bold = True
     
                For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation 30
                Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(3).Shapes("1F1").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(3).Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
    
    MsgBox "Before"
    
    Sleep 2000
    
    MsgBox "After"
    
    
    
    
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
     Next i
    
    
                 For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
    
     End If
     End With
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    I checked your code. It is working with Msgbox. If i removed Msgbox it is not working.

    How to do this without Msgbox

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Try replacing the 3 lines with just these

    I changed it to 10 seconds to test, and the hour glass seems to 'wait' for 10 seconds

                DoEvents
                Sleep 10000
    You can see the 3-4 rotate, but then it switches back so I assume that there's more code
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    It is not working

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Works for me

    "Not working" doesn't provide much to look at

    You used my file from post 8?

    Capture.JPG

    Load it
    Slide show
    Slide 3 - click the Red OFF
    3-4 rotates
    Hourglass for 10 seconds
    3-4 goes back

    I didn't look at the rest of your logic
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  11. #11
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    But when I am checking, 3-4 is not rotating and going back is not working. Directly it is going to 1-2 rotating

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Maybe your logic in this and the other macros is wrong

    Make P-BUTTON text = OFF and single step (F8) through the drv macro


    This rotates 3-4 back to original position

                 For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
                Next i

    Sub drv()
        Call MCI55_PUSH_BUTTON(ActivePresentation.Slides(3).Shapes("P-BUTTON"))
    End Sub
    
    
    
    
    Sub MCI55_PUSH_BUTTON(shp As Shape)
    
    
    Dim shpArrOnOff, shpArrOnOff1, shpArrColor, shpArrColor1, i As Long, i1 As Long, j As Long, j1 As Long
    
    
    '   Set shp = ActivePresentation.Slides(3).Shapes("P-BUTTON")
        
        shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
        shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
        shpArrOnOff = Array("RedClr31")
        shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
         
        With shp
           If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "OFF" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "OFF" Then
                
                .Fill.ForeColor.RGB = vbGreen
                .TextFrame.TextRange.Text = "ON"
                .TextFrame.TextRange.Font.Bold = True
     
                For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation 30
                Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(3).Shapes("1F1").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(3).Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
    
    
    
    
                DoEvents
                Sleep 10000
     
                 For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
                Next i
    
    
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
    
     End If
     End With
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  13. #13
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    I had modified the code my self. It is working now.

    Sub MCI55_PUSH_BUTTON()Dim shp As Shape, shpArrOnOff, shpArrOnOff1, shpArrColor, shpArrColor1, i As Long, i1 As Long, j As Long, j1 As Long
    
    
    
    
    Set shp = ActivePresentation.Slides(3).Shapes("P-BUTTON")
    shpArrColor = Array("RedClr32", "RedClr33", "RedClr37")
    shpArrColor1 = Array("RedClr34", "RedClr35", "RedClr36", "RedClr37")
    shpArrOnOff = Array("RedClr31")
    shpArrOnOff1 = Array("RedClr34", "RedClr38", "YellowClr7", "BlueClr7")
     With shp
     If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
    And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "OFF" Then
     .Fill.ForeColor.RGB = vbGreen
     .TextFrame.TextRange.Text = "ON"
     .TextFrame.TextRange.Font.Bold = True
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation 30
     Next i
     
              For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                If ActivePresentation.Slides(3).Shapes("MCCB-ON-OFF").TextFrame.TextRange.Text = "ON" _
                And ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 30
                End If
                Next i1
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbRed
                Next j
                 If ActivePresentation.Slides(3).Shapes("P-BUTTON").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(3).Shapes("1F1").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(3).Shapes("Group14").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(3).Shapes("Group15").Line.ForeColor.RGB = vbBlue
                End If
    
    
     Call SleepIt
    DoEvents
    Sleep 500
    
    
     For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
     ActivePresentation.Slides(3).Shapes.Range(shpArrOnOff(i)).IncrementRotation -30
     Next i
    
    
                 For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(3).Shapes.Range(shpArrColor1(j1)).Line.ForeColor.RGB = vbRed
                Next j1
    
    
     End If
     End With
    End Sub
    
    
    Sub SleepIt()
    Sleep 1000
    End Sub

  14. #14
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Good

    Glad it's working for you
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  15. #15
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Have you checked this

  16. #16
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    Quote Originally Posted by elsuji View Post
    Have you checked this
    No. Why?

    You said it was working for you

    It's not the way I would do it, but just so it works for you
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  17. #17
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    I created code for rotating shape once my condition is meet.

    my code is

    Sub MIXER_6K1_ON_OFF_SD()Dim shp As Shape, shpArrColor, shpArrColor1, shpArrOnOff, ShpArrRot, shpArrOnOff1, shpArrOnOff2, _
    i As Long, i1 As Long, i2 As Long, j As Long, j1 As Long, j2 As Long, x As Long
    
    
    
    
    Set shp = ActivePresentation.Slides(5).Shapes("MIXER ON/OFF")
    shpArrOnOff = Array("Orangeclr17", "RedClr7", "YellowClr7", "BlueClr7", "RedClr28")
    shpArrOnOff1 = Array("RedClr50", "YellowClr50", "BlueClr50")
    shpArrOnOff2 = Array("RedClr10", "YellowClr10", "BlueClr10")
    shpArrColor = Array("Group7", "Group8", "Group9", "Group10", "Group11", "Group12", "Group16", "Group17", "Group18", _
     "Group19", "Group20", "Group21", "Group22", "Group23", "Group24")
    shpArrColor1 = Array("Oval11", "Oval12")
    ShpArrRot = Array("Curved Down Arrow 253")
        With shp
            If .TextFrame.TextRange.Text = "ON" Then
                .Fill.ForeColor.RGB = vbRed
                .TextFrame.TextRange.Text = "OFF"
                .TextFrame.TextRange.Font.Bold = True
                For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).IncrementRotation -45
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).Line.ForeColor.RGB = vbBlack
                Next i
                
    
    
                For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                    If ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbRed Then
                        ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation -45
                    End If
                Next i1
    
    
                  
                For i2 = LBound(shpArrOnOff2) To UBound(shpArrOnOff2)
                If ActivePresentation.Slides(5).Shapes("Group20").Line.ForeColor.RGB = vbRed Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).IncrementRotation -45
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).Line.ForeColor.RGB = vbBlack
                End If
                Next i2
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(5).Shapes(shpArrColor1(j1)).Line.ForeColor.RGB = vbBlack
                    ActivePresentation.Slides(5).Shapes(shpArrColor1(j1)).Fill.ForeColor.RGB = vbBlack
                Next j1
                ActivePresentation.Slides(5).Shapes("RedClr19").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr20").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval14").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval14").Fill.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval13").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval13").Fill.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr18").Line.ForeColor.RGB = vbRed
                ActivePresentation.Slides(5).Shapes("Curved Down Arrow 253").Fill.ForeColor.RGB = vbRed
                ActivePresentation.Slides(5).Shapes("RedClr34").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr35").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = RGB(191, 191, 191)
    
    
            Else
            
                If ActivePresentation.Slides(5).Shapes("6Q1").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("6F2").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                .Fill.ForeColor.RGB = vbGreen
                .TextFrame.TextRange.Text = "ON"
                .TextFrame.TextRange.Font.Bold = True
                End If
                
    
    
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes("Oval11").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval11").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Group17").Line.ForeColor.RGB = RGB(255, 102, 0)
                    ActivePresentation.Slides(5).Shapes("RedClr19").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr20").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group18").Line.ForeColor.RGB = vbRed
                    For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).IncrementRotation 45
                    End If
                Next i
    
    
                    For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 45
                    End If
                Next i1
                
                    ActivePresentation.Slides(5).Shapes("Group7").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group8").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group9").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group16").Line.ForeColor.RGB = RGB(255, 102, 0)
                    
                    
                    ActivePresentation.Slides(5).Shapes("Oval14").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval14").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval13").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval13").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("RedClr28").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr7").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("YellowClr7").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("BlueClr7").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("RedClr18").Line.ForeColor.RGB = RGB(191, 191, 191)
                    ActivePresentation.Slides(5).Shapes("Orangeclr17").Line.ForeColor.RGB = RGB(255, 102, 0)
                    ActivePresentation.Slides(5).Shapes("Oval12").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval12").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Group21").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr34").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr35").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = RGB(191, 191, 191)
                    ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Curved Down Arrow 253").Fill.ForeColor.RGB = vbGreen
                 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(5).Shapes(ShpArrRot(x))
    Ratio = 0
     Do
     ' Rotate clockwise
     Ratio = Ratio + 0.02
     If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").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
    ContinueDo:
     Loop 'While True
     End With
     
     Dim WAIT As Double
    WAIT = Timer
    While Timer < WAIT + 5
       DoEvents  'do nothing
    Wend
    
    
            If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" Then
            ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = RGB(191, 191, 191)
            ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = RGB(191, 191, 191)
            ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = vbRed
            ActivePresentation.Slides(5).Shapes("Group20").Line.ForeColor.RGB = vbRed
            ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbBlack
                For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation -45
                Next i1
                
                For i2 = LBound(shpArrOnOff2) To UBound(shpArrOnOff2)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).IncrementRotation 45
                Next i2
                    ActivePresentation.Slides(5).Shapes("RedClr10").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("YellowClr10").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("BlueClr10").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group12").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group22").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group11").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group23").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group10").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group24").Line.ForeColor.RGB = vbRed
                
        End If
     
        End If
        End With
        
    End Sub
    this code is running my loop command

    Sub MIXER_6K1_ON_OFF_SD()Dim shp As Shape, shpArrColor, shpArrColor1, shpArrOnOff, ShpArrRot, shpArrOnOff1, shpArrOnOff2, _
    i As Long, i1 As Long, i2 As Long, j As Long, j1 As Long, j2 As Long, x As Long
    
    
    
    
    Set shp = ActivePresentation.Slides(5).Shapes("MIXER ON/OFF")
    shpArrOnOff = Array("Orangeclr17", "RedClr7", "YellowClr7", "BlueClr7", "RedClr28")
    shpArrOnOff1 = Array("RedClr50", "YellowClr50", "BlueClr50")
    shpArrOnOff2 = Array("RedClr10", "YellowClr10", "BlueClr10")
    shpArrColor = Array("Group7", "Group8", "Group9", "Group10", "Group11", "Group12", "Group16", "Group17", "Group18", _
     "Group19", "Group20", "Group21", "Group22", "Group23", "Group24")
    shpArrColor1 = Array("Oval11", "Oval12")
    ShpArrRot = Array("Curved Down Arrow 253")
        With shp
            If .TextFrame.TextRange.Text = "ON" Then
                .Fill.ForeColor.RGB = vbRed
                .TextFrame.TextRange.Text = "OFF"
                .TextFrame.TextRange.Font.Bold = True
                For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).IncrementRotation -45
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).Line.ForeColor.RGB = vbBlack
                Next i
                
    
    
                For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                    If ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbRed Then
                        ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation -45
                    End If
                Next i1
    
    
                  
                For i2 = LBound(shpArrOnOff2) To UBound(shpArrOnOff2)
                If ActivePresentation.Slides(5).Shapes("Group20").Line.ForeColor.RGB = vbRed Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).IncrementRotation -45
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).Line.ForeColor.RGB = vbBlack
                End If
                Next i2
                
                For j = LBound(shpArrColor) To UBound(shpArrColor)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrColor(j)).Line.ForeColor.RGB = vbBlack
                Next j
                For j1 = LBound(shpArrColor1) To UBound(shpArrColor1)
                    ActivePresentation.Slides(5).Shapes(shpArrColor1(j1)).Line.ForeColor.RGB = vbBlack
                    ActivePresentation.Slides(5).Shapes(shpArrColor1(j1)).Fill.ForeColor.RGB = vbBlack
                Next j1
                ActivePresentation.Slides(5).Shapes("RedClr19").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr20").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval14").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval14").Fill.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval13").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("Oval13").Fill.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr18").Line.ForeColor.RGB = vbRed
                ActivePresentation.Slides(5).Shapes("Curved Down Arrow 253").Fill.ForeColor.RGB = vbRed
                ActivePresentation.Slides(5).Shapes("RedClr34").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr35").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = RGB(191, 191, 191)
                ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = RGB(191, 191, 191)
    
    
            Else
            
                If ActivePresentation.Slides(5).Shapes("6Q1").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("6F2").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                .Fill.ForeColor.RGB = vbGreen
                .TextFrame.TextRange.Text = "ON"
                .TextFrame.TextRange.Font.Bold = True
                End If
                
    
    
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes("Oval11").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval11").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Group17").Line.ForeColor.RGB = RGB(255, 102, 0)
                    ActivePresentation.Slides(5).Shapes("RedClr19").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr20").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group18").Line.ForeColor.RGB = vbRed
                    For i = LBound(shpArrOnOff) To UBound(shpArrOnOff)
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff(i)).IncrementRotation 45
                    End If
                Next i
    
    
                    For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                 If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" _
                 And ActivePresentation.Slides(5).Shapes("INPUT_ON_OFF").TextFrame.TextRange.Text = "ON" Then
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation 45
                    End If
                Next i1
                
                    ActivePresentation.Slides(5).Shapes("Group7").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group8").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group9").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group16").Line.ForeColor.RGB = RGB(255, 102, 0)
                    
                    
                    ActivePresentation.Slides(5).Shapes("Oval14").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval14").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval13").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval13").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("RedClr28").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr7").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("YellowClr7").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("BlueClr7").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("RedClr18").Line.ForeColor.RGB = RGB(191, 191, 191)
                    ActivePresentation.Slides(5).Shapes("Orangeclr17").Line.ForeColor.RGB = RGB(255, 102, 0)
                    ActivePresentation.Slides(5).Shapes("Oval12").Line.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Oval12").Fill.ForeColor.RGB = vbGreen
                    ActivePresentation.Slides(5).Shapes("Group21").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr34").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr35").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = RGB(191, 191, 191)
                    ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Curved Down Arrow 253").Fill.ForeColor.RGB = vbGreen
                 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(5).Shapes(ShpArrRot(x))
    Ratio = 0
     Do
     ' Rotate clockwise
     Ratio = Ratio + 0.02
     If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").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
    ContinueDo:
     Loop 'While True
     End With
    Once it is reached after 5 second it should run the below command

    Dim WAIT As DoubleWAIT = Timer
    While Timer < WAIT + 5
       DoEvents  'do nothing
    Wend
    
    
            If ActivePresentation.Slides(5).Shapes("MIXER ON/OFF").TextFrame.TextRange.Text = "ON" Then
            ActivePresentation.Slides(5).Shapes("RedClr36").Line.ForeColor.RGB = RGB(191, 191, 191)
            ActivePresentation.Slides(5).Shapes("RedClr38").Line.ForeColor.RGB = RGB(191, 191, 191)
            ActivePresentation.Slides(5).Shapes("RedClr37").Line.ForeColor.RGB = vbRed
            ActivePresentation.Slides(5).Shapes("Group20").Line.ForeColor.RGB = vbRed
            ActivePresentation.Slides(5).Shapes("Group19").Line.ForeColor.RGB = vbBlack
                For i1 = LBound(shpArrOnOff1) To UBound(shpArrOnOff1)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff1(i1)).IncrementRotation -45
                Next i1
                
                For i2 = LBound(shpArrOnOff2) To UBound(shpArrOnOff2)
                    ActivePresentation.Slides(5).Shapes.Range(shpArrOnOff2(i2)).IncrementRotation 45
                Next i2
                    ActivePresentation.Slides(5).Shapes("RedClr10").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("YellowClr10").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("BlueClr10").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group12").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group22").Line.ForeColor.RGB = vbBlue
                    ActivePresentation.Slides(5).Shapes("Group11").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group23").Line.ForeColor.RGB = vbYellow
                    ActivePresentation.Slides(5).Shapes("Group10").Line.ForeColor.RGB = vbRed
                    ActivePresentation.Slides(5).Shapes("Group24").Line.ForeColor.RGB = vbRed
                
        End If
    But is not working. means after loop it is not going to next command.

    Can you please help me how to do this

  18. #18
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,740
    Location
    It's easier to check if you can attach a presentation with the macros and shapes and slides and etc.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  19. #19
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    Attached my file here. Go to slide no 5
    Attached Files Attached Files

  20. #20
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Paul,

    Please reply me for above my problem

Posting Permissions

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