LED Display Anyone?

MrIfOnly said:
Hi Kelly,

Yes, it is currently programmed to run up to 99.9 seconds, but you can modify the code as follows to allow for continuous running:

Replace:

Code: 
If sec2 = 10 Then Exit Sub

in the StartBtn click event code with:

Code: 
                If sec2 = 10 Then
                    msec = 0
                    sec = 0
                    sec2 = 0
                End If

Regards,

CJ
Click to expand...

Still it stops after sometime of running. I ran it first for 27 seconds then stops and again 37 seconds then stops
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Then it stops again after 54 seconds
 
Kelly,

I haven't been able to duplicate your problem. Does the counter stop at those numbers consistently? Are you performing any other actions when it stops? Are you running any other workbooks?

Stay tuned...new and improved code to come. Maybe it will fix your issues.

CJ
 
LED Display *NEW & IMPROVED!*

*NEW & IMPROVED!*

Now with 30% less hassle!

Added LCD display option. See picture below:

eGhVp1v.jpg


The following code (pasted into and run from a standard module) will generate everything for you in a new worksheet with the option of setting the number of digits via an input box at runtime.

Code: 
Option Explicit
Dim startX As Integer, startY As Integer, i As Integer, j As Integer, digitCnt As String
Dim WSNew As Worksheet
Const InitialstartX As Integer = 600, InitialstartY As Integer = 100
Sub NEWNUMBER()
Do 'input for number of digits
    digitCnt = InputBox("Enter number of digits to be generated.", Default:=3)
    If digitCnt = "" Then Exit Sub
    digitCnt = CInt(digitCnt)
Loop Until digitCnt > 0 And digitCnt < 8
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Set WSNew = ActiveWorkbook.ActiveSheet
ActiveWindow.DisplayGridlines = False
startX = InitialstartX
startY = InitialstartY
j = 1
For i = 1 To digitCnt 'total number of digits
    If i = 2 Then 'POINT
        With WSNew.Shapes.AddShape(msoShapeRectangle, InitialstartX - 23, InitialstartY + 138, 12, 12)
            .Name = "POINT"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 1
    End If
    If i = 4 Then 'Minutes Separator
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 110, 12, 12)
            .Name = "TOPSEP1"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 40, 12, 12)
            .Name = "BTMSEP1"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 2
    End If
    If i = 6 Then 'Hours Separator
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 110, 12, 12)
            .Name = "TOPSEP2"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 40, 12, 12)
            .Name = "BTMSEP2"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 2
    End If
'TOP1
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "TOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'MIDDLE1
    startX = startX - 3
    startY = startY + 74
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX + 4, startY - 1)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY - 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY - 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY - 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY + 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY + 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY + 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY + 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY - 1
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "MIDDLE" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'BOTTOM1
    startX = startX + 3
    startY = startY + 59
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipVertical
        .Name = "BOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'LEFTTOP1
    startX = startX - 6
    startY = startY - 127
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "LEFTTOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'LEFTBOTTOM1
    startX = startX
    startY = startY + 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "LEFTBOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'RIGHTTOP1
    startX = startX + 47
    startY = startY - 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipHorizontal
        .Name = "RIGHTTOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'RIGHTBOTTOM1
    startX = startX
    startY = startY + 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipHorizontal
        .Name = "RIGHTBOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
    startX = startX - 125
    startY = InitialstartY
Next i
'COMMAND & OPTION BUTTONS
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, InitialstartX + 80, InitialstartY, 120, 30)
        .ShapeStyle = msoShapeStylePreset25
        .OnAction = "runTimer"
        .Name = "StartBtn"
        .Title = digitCnt
        With .TextFrame2
            .TextRange.Characters.Text = "START"
            .TextRange.Characters.Font.Size = 16
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
    End With
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, InitialstartX + 80, InitialstartY + 60, 120, 30)
        .ShapeStyle = msoShapeStylePreset24
        .OnAction = "stpTimer"
        With .TextFrame2
            .TextRange.Characters.Text = "STOP"
            .TextRange.Characters.Font.Size = 16
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
    End With
WSNew.OLEObjects.Add ClassType:="Forms.OptionButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=InitialstartX + 100, Top:=InitialstartY + 110, _
    Width:=120, Height:=30
    
WSNew.OLEObjects.Add ClassType:="Forms.OptionButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=InitialstartX + 150, Top:=InitialstartY + 110, _
    Width:=120, Height:=30
    
    With ActiveSheet.OLEObjects("OptionButton1")
        .Name = "LEDOpt"
        .Object.AutoSize = True
        .Object.Caption = "LED"
        .Object.Value = True
    End With
    
    With ActiveSheet.OLEObjects("OptionButton2")
        .Name = "LCDOpt"
        .Object.AutoSize = True
        .Object.Caption = "LCD"
        .Object.Value = False
    End With
End Sub

The following code (pasted into a new standard module) will run the counter, automatically adjusting for the number of digits. It will loop back to zero after a total of 24 hours. I tested it up to one hour so more testing is needed though.

Code: 
Option Explicit
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer, min As Integer, min2 As Integer
Dim hr As Integer, hr2 As Integer, n As Integer, digitCnt As Integer
Dim Number As Object
Public setColor As String
Public stopTimer As Boolean
Public Sub runTimer()
digitCnt = ActiveSheet.Shapes("StartBtn").Title
stopTimer = False
sec = 0
sec2 = 0
min = 0
min2 = 0
hr = 0
hr2 = 0
If digitCnt > 1 Then PointON
If digitCnt > 3 Then SEP1ON
If digitCnt > 5 Then SEP2ON
    For n = 1 To digitCnt 'number of digits
        NumberON m:=0, n:=n
    Next n
 
Start = Timer    'Set start time.
    
    Do While Timer < Start + 100
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If digitCnt > 1 And msec = 5 Then PointOFF
        
        If msec = 10 Then '
            If digitCnt > 1 Then ''
                sec = sec + 1
                PointON
                If sec = 10 Then '
                    If digitCnt > 2 Then ''
                        sec2 = sec2 + 1
                        If sec2 = 6 Then '
                            If digitCnt > 3 Then ''
                                min = min + 1
                                If min = 10 Then '
                                    If digitCnt > 4 Then ''
                                        min2 = min2 + 1
                                        If min2 = 6 Then '
                                            If digitCnt > 5 Then ''
                                                hr = hr + 1
                                                If hr = 10 Then '
                                                    If digitCnt > 6 Then ''
                                                        hr2 = hr2 + 1
                                                        If hr2 = 2 And hr = 4 Then '
                                                            hr2 = 0
                                                            hr = 0
                                                        End If '
                                                    NumberON m:=hr2, n:=7
                                                    End If ''
                                                hr = 0
                                                End If '
                                            NumberON m:=hr, n:=6
                                            End If ''
                                        min2 = 0
                                        End If '
                                    NumberON m:=min2, n:=5
                                    End If ''
                                min = 0
                                End If '
                            NumberON m:=min, n:=4
                            End If ''
                        sec2 = 0
                        End If '
                    NumberON m:=sec2, n:=3
                    End If ''
                sec = 0
                End If '
            NumberON m:=sec, n:=2
            End If ''
        Start = Timer
        msec = 0
        End If '
        NumberON m:=msec, n:=1
    Loop
If digitCnt > 1 Then PointON
End Sub
Public Sub stpTimer()
    stopTimer = True
End Sub
Public Sub PointOFF()
    With ActiveSheet.Shapes("POINT").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0.9
    End With
End Sub
Public Sub PointON()
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("POINT").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub SEP1ON() 'Minutes Separator
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("TOPSEP1").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
    With ActiveSheet.Shapes("BTMSEP1").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub SEP2ON() 'Hour Separator
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("TOPSEP2").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
    With ActiveSheet.Shapes("BTMSEP2").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub NumberOFF(n As Integer)
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, _
    "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
With Number.Fill
    .Solid
    .ForeColor.RGB = setColor
    .Transparency = 0.9
End With
With Number.Glow
    .Color = setColor
    .Radius = IIf(.Radius = 0, 0, 0)
    .Transparency = 1
End With
End Sub
Sub NumberON(m As Integer, n As Integer)
NumberOFF n:=n
    Select Case m
        Case 1
        Set Number = ActiveSheet.Shapes.Range(Array("RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 2
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n))
        Case 3
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 4
        Set Number = ActiveSheet.Shapes.Range(Array("MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n, "RIGHTTOP" & n))
        Case 5
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n))
        Case 6
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTBOTTOM" & n))
        Case 7
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 8
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 9
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 0
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
    End Select
With Number.Fill
    .Solid
    .ForeColor.RGB = setColor
    .Transparency = 0
End With
End Sub

Regards,

CJ
 
Wow!!!! You are really doing a hard work!!!!. Can you send this one to me, please??
Kelly
 
I really like this LED and LCD display. But on my pc it always stops after sometime. When i ran this one first it took 1 minute 40 seconds then stops. I ran it again and had 1 min 49 seconds
 
I still can't duplicate this. I ran this on 2 different machines: WinXP running Excel 2010 and Win10 running Excel 2016. My laptop uses an AMD processor and I have noticed an intermittent lag when I move my mouse, but no stoppage. I was able to select cells in the sheet and move around using my arrow keys. The only time the counter stopped is when I typed something or clicked on a button in the ribbon. In fact, I was even able to play a rousing game of minesweeper while the counter continued to run.

CJ
 
Okay i will try and ran it on a different machine and see. Thanks and nice work. The LCD is super cool.
 
You must log in or register to reply here.

Forum statistics

Threads
1,216,075
Messages
6,128,662
Members
449,462
Latest member
Chislobog

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top