11 Aralık 2017 Pazartesi

Excel'de dijital saat kodlama



Sub Draw()

Dim TimeString As String
Dim WhichOrder(9) As Byte
WhichOrder(1) = 1: WhichOrder(2) = 10: WhichOrder(3) = 18: WhichOrder(4) = 20: WhichOrder(5) = 29: WhichOrder(6) = 37: WhichOrder(7) = 39: WhichOrder(8) = 48

Do
    TimeString = Time
   
    For n = 1 To 8
   
        If (n <> 3 And n <> 6) Then
            DrawNumber CByte(Mid(TimeString, n, 1)), WhichOrder(n)
        Else
            DrawPoint WhichOrder(n)
        End If
   
    Next n
    Range("A18").Select
    Application.Wait (Now + TimeValue("0:00:01"))
    seconds = seconds + 1
Loop Until (seconds = 60)
   
End Sub

Sub Clear()

    Range("A2:BF16").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A18").Select
   
End Sub

Sub DrawPoint(Order As Byte)
    For y = 3 To 3
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 9 To 9
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
End Sub

Sub DrawNumber(Number As Byte, Order As Byte)

Select Case Number
Case 1
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 2

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
'-------------------------------------
Case 3

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 4

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 5

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 6

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 7

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 8

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 9

    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
Case 0

For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For x = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For x = 1 To 5
        Cells(9 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlNone
        End With
    Next
   
    For x = 1 To 5
        Cells(15 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    y = 0
    For y = 1 To 5
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
   
    For y = 7 To 11
        Cells(3 + y, Order + 3 + x).Select
        With Selection.Interior
            .Color = vbBlue
            .Pattern = xlSolid
        End With
    Next
'-------------------------------------
End Select

End Sub

Hiç yorum yok:

Yorum Gönder