' Generates Bimagic Squares of order 9, Magic Sum 369, Victor Coccoz
' Based on Sudoku Comparable Squares
' Tested with Office 2007 under Windows 7
Sub CnstrSqrs42()
Dim a(81), b(81), c(81), s(34)
y = MsgBox("Blocked", vbCritical, "CntrSqrs42")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
For j1 = 152 To 159
GoSub 100 'Read a()
For j2 = 152 To 159
GoSub 200 'Read b()
For j3 = 1 To 81 'Calcualte c()
'' c(j3) = 9 * a(j3) + b(j3) + 1
c(j3) = a(j3) + 9 * b(j3) + 1
Next j3
GoSub 300: If fl1 = 0 Then GoTo 20 'Check Identical Numbers
GoSub 400: If fl1 = 0 Then GoTo 20 'Check Magic Sum
GoSub 500: If fl1 = 0 Then GoTo 20 'Check Bimagic Sum
GoSub 600: If fl1 = 0 Then GoTo 20 'Check Trimagic Sum (Main Diagonals)
' n9 = n9 + 1: GoSub 1000 'Print first lines (Test)
n9 = n9 + 1: GoSub 2650 'Print results (Squares)
20 Next j2
10 Next j1
End
' Read a()
100 'Model 1 2
a(1) = Sheets("Reeksen").Cells(j1, 1).Value ' B D
a(2) = Sheets("Reeksen").Cells(j1, 2).Value ' C b
a(3) = Sheets("Reeksen").Cells(j1, 3).Value ' A M
a(4) = Sheets("Reeksen").Cells(j1, 4).Value ' D d
a(5) = Sheets("Reeksen").Cells(j1, 5).Value ' d c
a(6) = Sheets("Reeksen").Cells(j1, 6).Value ' M B
a(7) = Sheets("Reeksen").Cells(j1, 7).Value ' b C
a(8) = Sheets("Reeksen").Cells(j1, 8).Value ' a a
a(9) = Sheets("Reeksen").Cells(j1, 9).Value ' c A
' Model 1
'' a(10) = a(8): a(11) = a(9): a(12) = a(7): a(13) = a(1): a(14) = a(3): a(15) = a(2): a(16) = a(5): a(17) = a(4): a(18) = a(6):
'' a(19) = a(4): a(20) = a(6): a(21) = a(5): a(22) = a(8): a(23) = a(7): a(24) = a(9): a(25) = a(3): a(26) = a(1): a(27) = a(2):
'' a(28) = a(7): a(29) = a(8): a(30) = a(9): a(31) = a(3): a(32) = a(2): a(33) = a(1): a(34) = a(6): a(35) = a(5): a(36) = a(4):
'' a(37) = a(3): a(38) = a(1): a(39) = a(2): a(40) = a(5): a(41) = a(6): a(42) = a(4): a(43) = a(9): a(44) = a(7): a(45) = a(8):
'' a(46) = a(5): a(47) = a(4): a(48) = a(6): a(49) = a(7): a(50) = a(9): a(51) = a(8): a(52) = a(2): a(53) = a(3): a(54) = a(1):
'' a(55) = a(9): a(56) = a(7): a(57) = a(8): a(58) = a(2): a(59) = a(1): a(60) = a(3): a(61) = a(4): a(62) = a(6): a(63) = a(5):
'' a(64) = a(6): a(65) = a(5): a(66) = a(4): a(67) = a(9): a(68) = a(8): a(69) = a(7): a(70) = a(1): a(71) = a(2): a(72) = a(3):
'' a(73) = a(2): a(74) = a(3): a(75) = a(1): a(76) = a(6): a(77) = a(4): a(78) = a(5): a(79) = a(8): a(80) = a(9): a(81) = a(7):
' Model 2
a(10) = a(5): a(11) = a(6): a(12) = a(2): a(13) = a(8): a(14) = a(9): a(15) = a(3): a(16) = a(4): a(17) = a(7): a(18) = a(1):
a(19) = a(7): a(20) = a(1): a(21) = a(9): a(22) = a(6): a(23) = a(4): a(24) = a(5): a(25) = a(2): a(26) = a(3): a(27) = a(8):
a(28) = a(2): a(29) = a(7): a(30) = a(8): a(31) = a(5): a(32) = a(6): a(33) = a(4): a(34) = a(1): a(35) = a(9): a(36) = a(3):
a(37) = a(6): a(38) = a(4): a(39) = a(7): a(40) = a(9): a(41) = a(3): a(42) = a(8): a(43) = a(5): a(44) = a(1): a(45) = a(2):
a(46) = a(3): a(47) = a(8): a(48) = a(4): a(49) = a(1): a(50) = a(2): a(51) = a(7): a(52) = a(9): a(53) = a(5): a(54) = a(6):
a(55) = a(9): a(56) = a(3): a(57) = a(6): a(58) = a(7): a(59) = a(1): a(60) = a(2): a(61) = a(8): a(62) = a(4): a(63) = a(5):
a(64) = a(4): a(65) = a(5): a(66) = a(1): a(67) = a(3): a(68) = a(8): a(69) = a(9): a(70) = a(6): a(71) = a(2): a(72) = a(7):
a(73) = a(8): a(74) = a(9): a(75) = a(5): a(76) = a(2): a(77) = a(7): a(78) = a(1): a(79) = a(3): a(80) = a(6): a(81) = a(4):
Return
' Read b()
200 'Model 1 2
b(1) = Sheets("Reeksen").Cells(j2, 11).Value ' R Q
b(2) = Sheets("Reeksen").Cells(j2, 12).Value ' n P
b(3) = Sheets("Reeksen").Cells(j2, 13).Value ' r p
b(4) = Sheets("Reeksen").Cells(j2, 14).Value ' Q S
b(5) = Sheets("Reeksen").Cells(j2, 15).Value ' p s
b(6) = Sheets("Reeksen").Cells(j2, 16).Value ' S n
b(7) = Sheets("Reeksen").Cells(j2, 17).Value ' q R
b(8) = Sheets("Reeksen").Cells(j2, 18).Value ' P q
b(9) = Sheets("Reeksen").Cells(j2, 19).Value ' s r
' Model 1
'' b(10) = b(5): b(11) = b(4): b(12) = b(6): b(13) = b(7): b(14) = b(9): b(15) = b(8): b(16) = b(2): b(17) = b(3): b(18) = b(1):
'' b(19) = b(9): b(20) = b(7): b(21) = b(8): b(22) = b(2): b(23) = b(1): b(24) = b(3): b(25) = b(4): b(26) = b(6): b(27) = b(5):
'' b(28) = b(2): b(29) = b(3): b(30) = b(1): b(31) = b(6): b(32) = b(4): b(33) = b(5): b(34) = b(8): b(35) = b(9): b(36) = b(7):
'' b(37) = b(7): b(38) = b(8): b(39) = b(9): b(40) = b(3): b(41) = b(2): b(42) = b(1): b(43) = b(6): b(44) = b(5): b(45) = b(4):
'' b(46) = b(4): b(47) = b(6): b(48) = b(5): b(49) = b(8): b(50) = b(7): b(51) = b(9): b(52) = b(3): b(53) = b(1): b(54) = b(2):
'' b(55) = b(8): b(56) = b(9): b(57) = b(7): b(58) = b(1): b(59) = b(3): b(60) = b(2): b(61) = b(5): b(62) = b(4): b(63) = b(6):
'' b(64) = b(3): b(65) = b(1): b(66) = b(2): b(67) = b(5): b(68) = b(6): b(69) = b(4): b(70) = b(9): b(71) = b(7): b(72) = b(8):
'' b(73) = b(6): b(74) = b(5): b(75) = b(4): b(76) = b(9): b(77) = b(8): b(78) = b(7): b(79) = b(1): b(80) = b(2): b(81) = b(3):
' Model 2
b(10) = b(4): b(11) = b(5): b(12) = b(1): b(13) = b(3): b(14) = b(8): b(15) = b(9): b(16) = b(6): b(17) = b(2): b(18) = b(7):
b(19) = b(6): b(20) = b(4): b(21) = b(7): b(22) = b(9): b(23) = b(3): b(24) = b(8): b(25) = b(5): b(26) = b(1): b(27) = b(2):
b(28) = b(8): b(29) = b(9): b(30) = b(5): b(31) = b(2): b(32) = b(7): b(33) = b(1): b(34) = b(3): b(35) = b(6): b(36) = b(4):
b(37) = b(2): b(38) = b(7): b(39) = b(8): b(40) = b(5): b(41) = b(6): b(42) = b(4): b(43) = b(1): b(44) = b(9): b(45) = b(3):
b(46) = b(5): b(47) = b(6): b(48) = b(2): b(49) = b(8): b(50) = b(9): b(51) = b(3): b(52) = b(4): b(53) = b(7): b(54) = b(1):
b(55) = b(3): b(56) = b(8): b(57) = b(4): b(58) = b(1): b(59) = b(2): b(60) = b(7): b(61) = b(9): b(62) = b(5): b(63) = b(6):
b(64) = b(9): b(65) = b(3): b(66) = b(6): b(67) = b(7): b(68) = b(1): b(69) = b(2): b(70) = b(8): b(71) = b(4): b(72) = b(5):
b(73) = b(7): b(74) = b(1): b(75) = b(9): b(76) = b(6): b(77) = b(4): b(78) = b(5): b(79) = b(2): b(80) = b(3): b(81) = b(8):
Return
' Check Identical Numbers
300 fl1 = 1
For j10 = 1 To 81
c2 = c(j10)
For j20 = (1 + j10) To 81
If c2 = c(j20) Then fl1 = 0: Return
Next j20
Next j10
Return
' Check Magic Sum
400 fl1 = 1
s(1) = c(1) + c(2) + c(3) + c(4) + c(5) + c(6) + c(7) + c(8) + c(9)
s(2) = c(10) + c(11) + c(12) + c(13) + c(14) + c(15) + c(16) + c(17) + c(18)
s(3) = c(19) + c(20) + c(21) + c(22) + c(23) + c(24) + c(25) + c(26) + c(27)
s(4) = c(28) + c(29) + c(30) + c(31) + c(32) + c(33) + c(34) + c(35) + c(36)
s(5) = c(37) + c(38) + c(39) + c(40) + c(41) + c(42) + c(43) + c(44) + c(45)
s(6) = c(46) + c(47) + c(48) + c(49) + c(50) + c(51) + c(52) + c(53) + c(54)
s(7) = c(55) + c(56) + c(57) + c(58) + c(59) + c(60) + c(61) + c(62) + c(63)
s(8) = c(64) + c(65) + c(66) + c(67) + c(68) + c(69) + c(70) + c(71) + c(72)
s(9) = c(73) + c(74) + c(75) + c(76) + c(77) + c(78) + c(79) + c(80) + c(81)
s(10) = c(1) + c(10) + c(19) + c(28) + c(37) + c(46) + c(55) + c(64) + c(73)
s(11) = c(2) + c(11) + c(20) + c(29) + c(38) + c(47) + c(56) + c(65) + c(74)
s(12) = c(3) + c(12) + c(21) + c(30) + c(39) + c(48) + c(57) + c(66) + c(75)
s(13) = c(4) + c(13) + c(22) + c(31) + c(40) + c(49) + c(58) + c(67) + c(76)
s(14) = c(5) + c(14) + c(23) + c(32) + c(41) + c(50) + c(59) + c(68) + c(77)
s(15) = c(6) + c(15) + c(24) + c(33) + c(42) + c(51) + c(60) + c(69) + c(78)
s(16) = c(7) + c(16) + c(25) + c(34) + c(43) + c(52) + c(61) + c(70) + c(79)
s(17) = c(8) + c(17) + c(26) + c(35) + c(44) + c(53) + c(62) + c(71) + c(80)
s(18) = c(9) + c(18) + c(27) + c(36) + c(45) + c(54) + c(63) + c(72) + c(81)
s(19) = c(1) + c(11) + c(21) + c(31) + c(41) + c(51) + c(61) + c(71) + c(81)
s(20) = c(73) + c(65) + c(57) + c(49) + c(41) + c(33) + c(25) + c(17) + c(9)
For i1 = 1 To 20
If s(i1) <> 369 Then fl1 = 0: Return
Next i1
Return
' Check Bimagic Sum
500 fl1 = 1: s2 = 20049
s(1) = c(1) ^ 2 + c(2) ^ 2 + c(3) ^ 2 + c(4) ^ 2 + c(5) ^ 2 + c(6) ^ 2 + c(7) ^ 2 + c(8) ^ 2 + c(9) ^ 2
s(2) = c(10) ^ 2 + c(11) ^ 2 + c(12) ^ 2 + c(13) ^ 2 + c(14) ^ 2 + c(15) ^ 2 + c(16) ^ 2 + c(17) ^ 2 + c(18) ^ 2
s(3) = c(19) ^ 2 + c(20) ^ 2 + c(21) ^ 2 + c(22) ^ 2 + c(23) ^ 2 + c(24) ^ 2 + c(25) ^ 2 + c(26) ^ 2 + c(27) ^ 2
s(4) = c(28) ^ 2 + c(29) ^ 2 + c(30) ^ 2 + c(31) ^ 2 + c(32) ^ 2 + c(33) ^ 2 + c(34) ^ 2 + c(35) ^ 2 + c(36) ^ 2
s(5) = c(37) ^ 2 + c(38) ^ 2 + c(39) ^ 2 + c(40) ^ 2 + c(41) ^ 2 + c(42) ^ 2 + c(43) ^ 2 + c(44) ^ 2 + c(45) ^ 2
s(6) = c(46) ^ 2 + c(47) ^ 2 + c(48) ^ 2 + c(49) ^ 2 + c(50) ^ 2 + c(51) ^ 2 + c(52) ^ 2 + c(53) ^ 2 + c(54) ^ 2
s(7) = c(55) ^ 2 + c(56) ^ 2 + c(57) ^ 2 + c(58) ^ 2 + c(59) ^ 2 + c(60) ^ 2 + c(61) ^ 2 + c(62) ^ 2 + c(63) ^ 2
s(8) = c(64) ^ 2 + c(65) ^ 2 + c(66) ^ 2 + c(67) ^ 2 + c(68) ^ 2 + c(69) ^ 2 + c(70) ^ 2 + c(71) ^ 2 + c(72) ^ 2
s(9) = c(73) ^ 2 + c(74) ^ 2 + c(75) ^ 2 + c(76) ^ 2 + c(77) ^ 2 + c(78) ^ 2 + c(79) ^ 2 + c(80) ^ 2 + c(81) ^ 2
s(10) = c(1) ^ 2 + c(10) ^ 2 + c(19) ^ 2 + c(28) ^ 2 + c(37) ^ 2 + c(46) ^ 2 + c(55) ^ 2 + c(64) ^ 2 + c(73) ^ 2
s(11) = c(2) ^ 2 + c(11) ^ 2 + c(20) ^ 2 + c(29) ^ 2 + c(38) ^ 2 + c(47) ^ 2 + c(56) ^ 2 + c(65) ^ 2 + c(74) ^ 2
s(12) = c(3) ^ 2 + c(12) ^ 2 + c(21) ^ 2 + c(30) ^ 2 + c(39) ^ 2 + c(48) ^ 2 + c(57) ^ 2 + c(66) ^ 2 + c(75) ^ 2
s(13) = c(4) ^ 2 + c(13) ^ 2 + c(22) ^ 2 + c(31) ^ 2 + c(40) ^ 2 + c(49) ^ 2 + c(58) ^ 2 + c(67) ^ 2 + c(76) ^ 2
s(14) = c(5) ^ 2 + c(14) ^ 2 + c(23) ^ 2 + c(32) ^ 2 + c(41) ^ 2 + c(50) ^ 2 + c(59) ^ 2 + c(68) ^ 2 + c(77) ^ 2
s(15) = c(6) ^ 2 + c(15) ^ 2 + c(24) ^ 2 + c(33) ^ 2 + c(42) ^ 2 + c(51) ^ 2 + c(60) ^ 2 + c(69) ^ 2 + c(78) ^ 2
s(16) = c(7) ^ 2 + c(16) ^ 2 + c(25) ^ 2 + c(34) ^ 2 + c(43) ^ 2 + c(52) ^ 2 + c(61) ^ 2 + c(70) ^ 2 + c(79) ^ 2
s(17) = c(8) ^ 2 + c(17) ^ 2 + c(26) ^ 2 + c(35) ^ 2 + c(44) ^ 2 + c(53) ^ 2 + c(62) ^ 2 + c(71) ^ 2 + c(80) ^ 2
s(18) = c(9) ^ 2 + c(18) ^ 2 + c(27) ^ 2 + c(36) ^ 2 + c(45) ^ 2 + c(54) ^ 2 + c(63) ^ 2 + c(72) ^ 2 + c(81) ^ 2
s(19) = c(1) ^ 2 + c(11) ^ 2 + c(21) ^ 2 + c(31) ^ 2 + c(41) ^ 2 + c(51) ^ 2 + c(61) ^ 2 + c(71) ^ 2 + c(81) ^ 2
s(20) = c(73) ^ 2 + c(65) ^ 2 + c(57) ^ 2 + c(49) ^ 2 + c(41) ^ 2 + c(33) ^ 2 + c(25) ^ 2 + c(17) ^ 2 + c(9) ^ 2
For i1 = 1 To 20
If s(i1) <> s2 Then fl1 = 0: Return
Next i1
Return
' Check Trimagic Sum (Main Diagonals)
600 fl1 = 1: s3 = 1225449
s(1) = c(1) ^ 3 + c(11) ^ 3 + c(21) ^ 3 + c(31) ^ 3 + c(41) ^ 3 + c(51) ^ 3 + c(61) ^ 3 + c(71) ^ 3 + c(81) ^ 3
s(2) = c(73) ^ 3 + c(65) ^ 3 + c(57) ^ 3 + c(49) ^ 3 + c(41) ^ 3 + c(33) ^ 3 + c(25) ^ 3 + c(17) ^ 3 + c(9) ^ 3
For i1 = 1 To 2
If s(i1) <> s3 Then fl1 = 0: Return
Next i1
Return
' Print Lines
1000 Cells(n9, 32).Select
For i1 = 1 To 9
Cells(n9, i1).Value = a(i1)
Cells(n9, i1 + 10).Value = b(i1)
Cells(n9, i1 + 20).Value = c(i1)
Next i1
Cells(n9, 31).Value = j1
Cells(n9, 32).Value = j2
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 10: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 10
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 9
For i2 = 1 To 9
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i3)
Next i2
Next i1
Return
End Sub
