About the Author

' Reads data Base, Essential Different Only, V ZigZag Two Way

' Tested with Office 2007 under Windows 7

Sub ReadDb8z2(fl8)
    
    Dim MyDB As Database, MyWorkSpace As Workspace
    Dim Td1 As Recordset
    
    Dim a(64), s(64)
       
    If fl8 = 1 Then
        Cells(n9 + 1, 65).Select
    Else
        Cells(k1 + 1, 1).Select
    End If
       
    Sheets("Klad1").Select
   
    f1 = "C:\Users\Jos\Devellopments\Vierkanten\Bimagic\Trump8\Bimagic8.mdb"
    f2 = "Bimagic8"

    k1 = 1: k2 = 1

'   Open the database and input table

    Set MyWorkSpace = DBEngine.Workspaces(0)
    Set MyDB = MyWorkSpace.OpenDatabase(f1)
    Set Td1 = MyDB.OpenRecordset(f2, dbOpenTable)
    
    Td1.MoveFirst
    Do Until Td1.EOF

        n10 = n10 + 1
        If fl8 = 1 Then
            Cells(n9 + 1, 65).Value = n10
        Else
            Cells(k1 + 1, 1).Value = n10
        End If
    
'       Read Record
        
        For j1 = 1 To 64
            FldName = "Veld" + CStr(j1)
            t1 = Td1.Fields(FldName)
            a(j1) = t1
        Next j1

'       Check Criterium

        GoSub 150                    'ZigZag
        GoSub 500                    'Check Property
        
        If fl1 = 1 Then
            n9 = n9 + 1
            If fl8 = 1 Then
               GoSub 645             'Print results (selected numbers)
            Else
               GoSub 650             'Print results (squares)
            End If
        End If

        Td1.MoveNext
    Loop
    
    y = MsgBox("Records: " + CStr(n9), vbInformation, "ReadDb8a")
    
    MyDB.Close

End

500 fl1 = 1
    For i1 = 1 To n4
        If s(i1) <> s2 Then fl1 = 0: Return
    Next i1
    Return
   
'   V Zig Zag

150 n4 = 8:  s2 = 260   'Two  Way ZigZag
''  n4 = 16: S2 = 260   'Four Way ZigZag (***Fails ***)
     
    s(1) = a(1) + a(10) + a(3) + a(12) + a(5) + a(14) + a(7) + a(16)
    s(2) = a(9) + a(18) + a(11) + a(20) + a(13) + a(22) + a(15) + a(24)
    s(3) = a(17) + a(26) + a(19) + a(28) + a(21) + a(30) + a(23) + a(32)
    s(4) = a(25) + a(34) + a(27) + a(36) + a(29) + a(38) + a(31) + a(40)
    s(5) = a(33) + a(42) + a(35) + a(44) + a(37) + a(46) + a(39) + a(48)
    s(6) = a(41) + a(50) + a(43) + a(52) + a(45) + a(54) + a(47) + a(56)
    s(7) = a(49) + a(58) + a(51) + a(60) + a(53) + a(62) + a(55) + a(64)
    s(8) = a(57) + a(2) + a(59) + a(4) + a(61) + a(6) + a(63) + a(8)
        
''  s(9) = a(1) + a(10) + a(17) + a(26) + a(33) + a(42) + a(49) + a(58)
''  s(10) = a(2) + a(11) + a(18) + a(27) + a(34) + a(43) + a(50) + a(59)
''  s(11) = a(3) + a(12) + a(19) + a(28) + a(35) + a(44) + a(51) + a(60)
''  s(12) = a(4) + a(13) + a(20) + a(29) + a(36) + a(45) + a(52) + a(61)
''  s(13) = a(5) + a(14) + a(21) + a(30) + a(37) + a(46) + a(53) + a(62)
''  s(14) = a(6) + a(15) + a(22) + a(31) + a(38) + a(47) + a(54) + a(63)
''  s(15) = a(7) + a(16) + a(23) + a(32) + a(39) + a(48) + a(55) + a(64)
''  s(16) = a(8) + a(9) + a(24) + a(25) + a(40) + a(41) + a(56) + a(57)

    Return
    
'   Print results (selected numbers)

645 For i1 = 1 To 64
         Cells(n9, i1).Value = a(i1)
     Next i1
     Cells(n9, 65).Select
     Cells(n9, 65).Value = n9
     Return

'   Print results (squares)

650 n2 = n2 + 1
     If n2 = 5 Then
         n2 = 1: k1 = k1 + 9: k2 = 1
     Else
         If n9 > 1 Then k2 = k2 + 9
     End If
     
     Cells(k1, k2 + 1).Select
     Cells(k1, k2 + 1).Font.Color = -4165632
     Cells(k1, k2 + 1).Value = CStr(n9)
    
     i3 = 0
     For i1 = 1 To 8
         For i2 = 1 To 8
             i3 = i3 + 1
             Cells(k1 + i1, k2 + i2).Value = a(i3)
         Next i2
     Next i1
    
     Return

End Sub

About the Author