MrIfOnly
Active Member
- Joined
- Nov 10, 2016
- Messages
- 497
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:
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):
The code for the commandbuttons (paste into worksheet module):
Spinbutton option if you want it (again, paste into worksheet module):
And, finally, the code to run the numbers (paste into standard module):
Regards,
CJ
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:
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