LED Display Anyone?

MrIfOnly

MrIfOnly

Active Member
Joined
Nov 10, 2016
Messages
493
Anyone looking for a LED display in Excel?

So, I've been bored the past couple of days and started tinkering around with this. I thought it was kind of cool and figured I'd share. I really don't have any application for it, so if you do use it, please satisfy my curiosity by posting your use for it.

It looks like this:

DbGajCb.jpg

Imgur: The most awesome images on the Internet

The code for creating the number shape (note the note noted in red :)) on a new sheet that you can copy and paste into your working worksheet (paste code into standard module and run as many times as needed):

Code: 
Sub newNumber()
Dim startX As Integer, startY As Integer, i As Integer
Dim WSNew As Worksheet
i = 1 [COLOR=#ff0000]'set as increment number for each new digit[/COLOR]
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Set WSNew = ActiveWorkbook.ActiveSheet
'TOP1
startX = 500
startY = 100
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(1)
    .Name = "TOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'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(2)
    .Name = "MIDDLE" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'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(3)
    .Flip msoFlipVertical
    .Name = "BOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'LEFTTOP1
startX = 494
startY = 106
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(4)
    .Name = "LEFTTOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'LEFTBOTTOM1
startX = 494
startY = 175
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(5)
    .Name = "LEFTBOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'RIGHTTOP1
startX = 541
startY = 106
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(6)
    .Flip msoFlipHorizontal
    .Name = "RIGHTTOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'RIGHTBOTTOM1
startX = 541
startY = 175
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(7)
    .Flip msoFlipHorizontal
    .Name = "RIGHTBOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
End Sub

The code for the commandbuttons (paste into worksheet module):

Code: 
Option Explicit
Dim stopTimer As Boolean
Dim n As Integer

Private Sub OnBtn_Click()
    For n = 1 To 3
        NumberON m:=8, n:=n
        Shapes("POINT").Fill.Transparency = 0
    Next n
End Sub
Private Sub OffBtn_Click()
    For n = 1 To 3
        NumberOFF n:=n
        Shapes("POINT").Fill.Transparency = 0.9
    Next n
End Sub
Private Sub StartBtn_Click()
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer
    stopTimer = False
    
    Shapes("POINT").Fill.Transparency = 0
    For n = 1 To 3
        NumberON m:=0, n:=n
    Next n
    
    Start = Timer    ' Set start time.
    
    Do While Timer < Start + 100 'set this number to limit the time the clock will run
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If msec = 10 Then
            sec = sec + 1
            If sec = 10 Then
                sec2 = sec2 + 1
                If sec2 = 10 Then Exit Sub
                NumberON m:=sec2, n:=3
                sec = 0
            End If
            Start = Timer
            With Shapes("POINT").Glow
                .Color = RGB(255, 0, 0)
                .Radius = IIf(.Radius = 0, 5, 0)
                .Transparency = 0.5
            End With
            NumberON m:=sec, n:=2
            msec = 0
        End If
        NumberON m:=msec, n:=1
    Loop
    
    With Shapes("POINT").Glow
        .Color = RGB(255, 0, 0)
        .Radius = IIf(.Radius = 0, 5, 0)
        .Transparency = 1
    End With
End Sub
Private Sub StopBtn_Click()
    stopTimer = True
End Sub

Spinbutton option if you want it (again, paste into worksheet module):

Code: 
Private Sub SpinButton1_Change()
    If SpinButton1.Value > 9 Then SpinButton1.Value = 0
    If SpinButton1.Value < 0 Then SpinButton1.Value = 9
    NumberON m:=SpinButton1.Value, n:=1
End Sub

And, finally, the code to run the numbers (paste into standard module):

Code: 
Option Explicit
Dim Number As Object, shape8 As Object

Public Sub NumberOFF(n As Integer)
Set shape8 = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, _
    "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
With shape8.Fill
    .Solid
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0.9
End With
With shape8.Glow
    .Color = RGB(255, 0, 0)
    .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 = RGB(255, 0, 0)
    .Transparency = 0
End With
With Number.Glow
    .Color = 2238442
    .Radius = IIf(.Radius = 0, 2, 0)
    .Transparency = 0.8
End With
End Sub

Regards,
CJ
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Just a lot of time on my hands at work the past couple of days. As Albert Speer said in his prison memoirs: "The one circle of hell that Dante forgot was ennui."
 
I will copy it and use it for my project. Will get u posted when i am true.

By the way can i show it on a userform????
 
As it is, no. When I get a chance I'll try to adapt it to work on userforms.
 
Do i have to paste all worksheet module codes into one sheet module or different modules???
 
Last edited by a moderator:
Paste the code for the commandbuttons and/or spinbutton into the module for the sheet on which they (and the number layout) reside.
 
Does this script install all the Buttons?
It appears as if there are:

One Spin Button
Two Command Buttons
Two Option Buttons

These look like Form Controls: True ?
 
Last edited:
You must log in or register to reply here.

Forum statistics

Threads
1,223,719
Messages
6,174,089
Members
452,542
Latest member
Bricklin

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