ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Blinking Button (https://www.excelbanter.com/excel-discussion-misc-queries/270632-blinking-button.html)

apis

Blinking Button
 
hello everyone,
I would like to create a blinking button...What I have done
is....
================================================== ===========================

Sub blinking()

Dim X As Integer

x = 0

DD:
X = X + 1

If ActiveSheet.Buttons("Button 1").Text = "BUTTON 1" Then
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.Buttons("Button 1").Text = ""

ElseIf ActiveSheet.Buttons("Button 1").Text = "" Then
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.Buttons("Button 1").Text = "BUTTON 1"

End If

If X < 10 Then

GoTo DD

End If

End Sub

================================================== ===========
The problem is...this only limited to x=10..meaning its blinking
around 5 times..and during this time, i cant click on anything..i want
the loop to go on and on until user click on another button. something
like a interrupt request... is there any solution for this ?

regards,
Aisar

James Ravenswood

Blinking Button
 
On Nov 17, 5:38*am, apis wrote:
hello everyone,
* * * I would like to create a blinking button...What I have done
is....
================================================== =========================*==

Sub blinking()

Dim X As Integer

x = 0

DD:
X = X + 1

If ActiveSheet.Buttons("Button 1").Text = "BUTTON 1" Then
* *Application.Wait Now + TimeValue("00:00:01")
* *ActiveSheet.Buttons("Button 1").Text = ""

ElseIf ActiveSheet.Buttons("Button 1").Text = "" Then
* *Application.Wait Now + TimeValue("00:00:01")
* *ActiveSheet.Buttons("Button 1").Text = "BUTTON 1"

End If

If X < 10 Then

GoTo DD

End If

End Sub

================================================== ===========
The problem is...this only limited to x=10..meaning its blinking
around 5 times..and during this time, i cant click on anything..i want
the loop to go on and on until user click on another button. something
like a interrupt request... is there any solution for this ?

regards,
Aisar


Here is a small example. Routine calls ButtonMaker to place a button
on the sheet. An "infinite" loop is then entered. The button flashes
in this loop. Once the button is pushed, the loop can exit.

Because we are using DoEvents in the loop, the user shares focus and
can manipulate the worksheet. Using Waits "freezes the user out until
the macro is done.

James Ravenswood

Blinking Button
 
On Nov 17, 5:38*am, apis wrote:
hello everyone,
* * * I would like to create a blinking button...What I have done
is....
================================================== =========================*==

Sub blinking()

Dim X As Integer

x = 0

DD:
X = X + 1

If ActiveSheet.Buttons("Button 1").Text = "BUTTON 1" Then
* *Application.Wait Now + TimeValue("00:00:01")
* *ActiveSheet.Buttons("Button 1").Text = ""

ElseIf ActiveSheet.Buttons("Button 1").Text = "" Then
* *Application.Wait Now + TimeValue("00:00:01")
* *ActiveSheet.Buttons("Button 1").Text = "BUTTON 1"

End If

If X < 10 Then

GoTo DD

End If

End Sub

================================================== ===========
The problem is...this only limited to x=10..meaning its blinking
around 5 times..and during this time, i cant click on anything..i want
the loop to go on and on until user click on another button. something
like a interrupt request... is there any solution for this ?

regards,
Aisar


Dim OK_To_Proceed As Boolean

Private Sub BigMac()
OK_To_Proceed = True
End Sub

Private Sub ButtonMaker()
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectang le, 162.75, 85.5,
119.25, _
68.25).Select
With Selection.ShapeRange.Fill
.ForeColor.SchemeColor = 13
.Visible = msoTrue
.Solid
End With
Selection.Characters.Text = "PROCEED"
With Selection.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.OnAction = "BigMac"
.Name = "PROCEED"
End With
Range("A1").Select
End Sub

Sub routine()
Call ButtonMaker
Dim sh As Shape
Set sh = ActiveSheet.Shapes("PROCEED")
OK_To_Proceed = False
While Not OK_To_Proceed
For j = 1 To 5000
DoEvents
Next
sh.Visible = False
For j = 1 To 5000
DoEvents
Next
sh.Visible = True
Wend
End Sub


All times are GMT +1. The time now is 06:34 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com