Vorige Pagina About the Author

' Reads Top squares of Perfect Magic Cubes of order 5 for integers 1 thru 125
' Calculates Perfect Magic Cubes

' Tested with Office 2007 under Windows 7

Sub MgcCube5a2()
Dim a(125), b(125), c(125)

y = MsgBox("Locked", vbCritical, "Routine MgcCube5b2")
End

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 125: s1 = 315
  
     Sheets("Klad1").Select
    
     t1 = Timer

For j10 = 115 To 122
Cells(k1, 1).Select: Cells(k1, 1).Value = j10

    ' Read Generated Top Square
    
    For j20 = 1 To 25
        a(j20 + 100) = Sheets("Trump1").Cells(j10, j20 + 100).Value  'In case of complete available Cube (line format)
    '   a(j20 + 100) = Sheets("Random5").Cells(j10, j20).Value       'In case of Top Square              (line format)
    Next j20
    
    ' Calculate corresponding pair elements (Symmetry)
    
    a(1) = 126 - a(125):  a(2) = 126 - a(122):  a(3) = 126 - a(123):  a(4) = 126 - a(124):  a(5) = 126 - a(121):
    a(6) = 126 - a(110):  a(7) = 126 - a(107):  a(8) = 126 - a(108):  a(9) = 126 - a(109):  a(10) = 126 - a(106):
    a(11) = 126 - a(115): a(12) = 126 - a(112): a(13) = 126 - a(113): a(14) = 126 - a(114): a(15) = 126 - a(111):
    a(16) = 126 - a(120): a(17) = 126 - a(117): a(18) = 126 - a(118): a(19) = 126 - a(119): a(20) = 126 - a(116):
    a(21) = 126 - a(105): a(22) = 126 - a(102): a(23) = 126 - a(103): a(24) = 126 - a(104): a(25) = 126 - a(101):
    
    Erase b, c
    
    For j20 = 101 To 125
        b(a(j20)) = a(j20): b(a(j20 - 100)) = a(j20 - 100)
    Next j20
    
    a(63) = 63: b(a(63)) = a(63)
    
    GoSub 1600                   ' Complete Cube

Next j10

     t2 = Timer
    
     t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
     y = MsgBox(t10, 0, "Routine MgcCube5b2")

End

'    Complete Cube

1600 n10 = 0

     For j100 = m1 To m2
     If b(j100) = 0 Then b(j100) = j100: c(100) = j100 Else GoTo 1000
     a(100) = j100

     a(26) = 126 - a(100): If b(a(26)) = 0 Then b(a(26)) = a(26): c(26) = a(26) Else GoTo 260

     For j99 = m1 To m2
     If b(j99) = 0 Then b(j99) = j99: c(99) = j99 Else GoTo 990
     a(99) = j99

     a(27) = 126 - a(99): If b(a(27)) = 0 Then b(a(27)) = a(27): c(27) = a(27) Else GoTo 270

     For j98 = m1 To m2
     If b(j98) = 0 Then b(j98) = j98: c(98) = j98 Else GoTo 980
     a(98) = j98

     a(28) = 126 - a(98): If b(a(28)) = 0 Then b(a(28)) = a(28): c(28) = a(28) Else GoTo 280

     For j97 = m1 To m2
     If b(j97) = 0 Then b(j97) = j97: c(97) = j97 Else GoTo 970
     a(97) = j97

     a(96) = s1 - a(97) - a(98) - a(99) - a(100)
     If a(96) <= 0 Or a(96) > 125 Then GoTo 960
     If b(a(96)) = 0 Then b(a(96)) = a(96): c(96) = a(96) Else GoTo 960
     
     a(65) = (-17*s1 + 10*a(97) + 10*a(98) + 10*a(99) + 20*a(100) + 10*a(117) + 10*a(118) + 10*a(119) + 20*a(120)) / 15
     If a(65) <= 0 Or a(65) > 125 Or CInt(a(65)) <> a(65) Then GoTo 650
     If b(a(65)) = 0 Then b(a(65)) = a(65): c(65) = a(65) Else GoTo 650
    
     a(64) = (3*s1 - 10*a(97) + 10*a(99) + 5*a(112) - 5*a(114) + 10*a(117) - 10*a(119) + 10*a(122) - 10*a(124)) / 15
     If a(64) <= 0 Or a(64) > 125 Or CInt(a(64)) <> a(64) Then GoTo 640
     If b(a(64)) = 0 Then b(a(64)) = a(64): c(64) = a(64) Else GoTo 640
              
     a(62) = 126 - a(64): If b(a(62)) = 0 Then b(a(62)) = a(62): c(62) = a(62) Else GoTo 620
     a(61) = 126 - a(65): If b(a(61)) = 0 Then b(a(61)) = a(61): c(61) = a(61) Else GoTo 610
     a(30) = 126 - a(96): If b(a(30)) = 0 Then b(a(30)) = a(30): c(30) = a(30) Else GoTo 300
     a(29) = 126 - a(97): If b(a(29)) = 0 Then b(a(29)) = a(29): c(29) = a(29) Else GoTo 290
     
     For j95 = m1 To m2
     If b(j95) = 0 Then b(j95) = j95: c(95) = j95 Else GoTo 950
     a(95) = j95

     a(91) = (-7*s1 + 3*a(95) + 2*a(97) + 2*a(98) + 2*a(99) + 4*a(100) + 2*a(117) + 2*a(118) + 2*a(119) + 4*a(120) + 
                                                                       + 3*a(122) + 3*a(123) + 3*a(124) + 6*a(125)) / 3
     If a(91) <= 0 Or a(91) > 125 Or CInt(a(91)) <> a(91) Then GoTo 910
     If b(a(91)) = 0 Then b(a(91)) = a(91): c(91) = a(91) Else GoTo 910

     a(35) = 126 - a(91): If b(a(35)) = 0 Then b(a(35)) = a(35): c(35) = a(35) Else GoTo 350
     a(31) = 126 - a(95): If b(a(31)) = 0 Then b(a(31)) = a(31): c(31) = a(31) Else GoTo 310


For j94 = m1 To m2
If b(j94) = 0 Then b(j94) = j94: c(94) = j94 Else GoTo 940
a(94) = j94

a(93) = 1050 - 2*(a(94) + a(95) + a(125)) - a(123) + (-2*a(98) - 4*a(99) - 4*a(100) - a(112) + 
                                                      + a(114) - 4*a(117) - 2*a(118) - 4*a(120) - 5*a(122) - a(124)) / 3
If a(93) <= 0 Or a(93) > 125 Or CInt(a(93)) <> a(93) Then GoTo 930
If b(a(93)) = 0 Then b(a(93)) = a(93): c(93) = a(93) Else GoTo 930
     
a(92) = 315 - a(93) - a(94) - 2 * a(95) + 2 * (a(96) - a(100) + a(116) - a(120)) / 3 + a(121) - a(125)
If a(92) <= 0 Or a(92) > 125 Or CInt(a(92)) <> a(92) Then GoTo 920
If b(a(92)) = 0 Then b(a(92)) = a(92): c(92) = a(92) Else GoTo 920
     
a(80) = (153*s1 - 54*a(94) - 36*a(95) + 15*a(97) + 15*a(98) - 21*a(99) - 9*a(100) - 30*a(110) - 36*a(114) +
                - 54*a(115) - 36*a(118) - 72 * a(119) - 102*a(120) - 30*a(122) - 54*a(123) - 102*a(124) - 144*a(125)) / 15
If a(80) <= 0 Or a(80) > 125 Or CInt(a(80)) <> a(80) Then GoTo 800
If b(a(80)) = 0 Then b(a(80)) = a(80): c(80) = a(80) Else GoTo 800

a(79) = (-187*s1 + 36*a(94) + 24*a(95) - 10*a(97) - 10*a(98) + 29*a(99) + 16*a(100) + 45*a(110) + 54*a(114) + 81*a(115) + 
                 - 10*a(117) + 44*a(118) + 98*a(119) + 133*a(120) + 30*a(122) + 66*a(123) + 138*a(124) + 186*a(125)) / 15
If a(79) <= 0 Or a(79) > 125 Or CInt(a(79)) <> a(79) Then GoTo 790
If b(a(79)) = 0 Then b(a(79)) = a(79): c(79) = a(79) Else GoTo 790

a(78) = (68*s1 + 36*a(94) + 24*a(95) - 10*a(97) + 5*a(98) + 14*a(99) + 16*a(100) - 30*a(110) + 15*a(112) - 51*a(114) +  
               - 54*a(115) + 50*a(117) - 16*a(118) - 82*a(119) - 62*a(120) + 30*a(122) - 24*a(123) - 102*a(124) - 84*a(125)) / 15
If a(78) <= 0 Or a(78) > 125 Or CInt(a(78)) <> a(78) Then GoTo 780
If b(a(78)) = 0 Then b(a(78)) = a(78): c(78) = a(78) Else GoTo 780

a(77) = (-187*s1 + 36*a(94) + 24*a(95) + 5*a(97) - 10*a(98) + 14*a(99) + 16*a(100) + 45*a(110) - 15*a(112) + 69*a(114) + 
                 + 81*a(115) - 40 * a(117) + 44*a(118) + 128*a(119) + 133*a(120) + 66*a(123) + 168*a(124) + 186*a(125)) / 15
If a(77) <= 0 Or a(77) > 125 Or CInt(a(77)) <> a(77) Then GoTo 770
If b(a(77)) = 0 Then b(a(77)) = a(77): c(77) = a(77) Else GoTo 770

a(76) = (168*s1 - 54*a(94) - 36*a(95) - 36*a(99) - 39*a(100) - 30*a(110) - 36*a(114) - 54*a(115) - 36*a(118) - 72*a(119) +
                                                             - 102*a(120) - 30*a(122) - 54*a(123) - 102*a(124) - 144*a(125)) / 15
If a(76) <= 0 Or a(76) > 125 Or CInt(a(76)) <> a(76) Then GoTo 760
If b(a(76)) = 0 Then b(a(76)) = a(76): c(76) = a(76) Else GoTo 760

a(75) = (201*s1 - 54*a(94) - 36*a(95) - 36*a(99) - 54*a(100) - 45*a(110) + 15*a(112) - 51*a(114) - 69*a(115) + 30*a(117) +
                                      - 36*a(118) - 102*a(119) - 117*a(120) - 15*a(122) - 69*a(123) - 147*a(124) - 204*a(125)) / 15
If a(75) <= 0 Or a(75) > 125 Or CInt(a(75)) <> a(75) Then GoTo 750
If b(a(75)) = 0 Then b(a(75)) = a(75): c(75) = a(75) Else GoTo 750

a(74) = (-79*s1 + 36*a(94) + 24*a(95) + 5*a(97) - 10*a(98) - a(99) + 16*a(100) + 30*a(110) - 15*a(112) + 24*a(114) + 
                + 36*a(115) - 25*a(117) + 14*a(118) + 53*a(119) + 58*a(120) - 15*a(122) + 21*a(123) + 63*a(124) + 96*a(125)) / 15
If a(74) <= 0 Or a(74) > 125 Or CInt(a(74)) <> a(74) Then GoTo 740
If b(a(74)) = 0 Then b(a(74)) = a(74): c(74) = a(74) Else GoTo 740

a(73) = (-169*s1 + 36*a(94) + 24*a(95) - 10*a(97) - 10*a(98) + 14*a(99) + 16*a(100) + 30*a(110) + 54*a(114) + 66*a(115) +
                            - 10*a(117) + 44*a(118) + 98*a(119) + 118*a(120) + 30*a(122) + 66*a(123) + 138*a(124) + 156*a(125)) / 15
If a(73) <= 0 Or a(73) > 125 Or CInt(a(73)) <> a(73) Then GoTo 730
If b(a(73)) = 0 Then b(a(73)) = a(73): c(73) = a(73) Else GoTo 730

a(72) = (-79*s1 + 36*a(94) + 24*a(95) - 25*a(97) - 10*a(98) + 29*a(99) + 16*a(100) + 30*a(110) + 9*a(114) + 36*a(115) + 
                           + 5*a(117) + 14*a(118) + 23*a(119) + 58*a(120) + 15*a(122) + 21*a(123) + 33*a(124) + 96*a(125)) / 15
If a(72) <= 0 Or a(72) > 125 Or CInt(a(72)) <> a(72) Then GoTo 720
If b(a(72)) = 0 Then b(a(72)) = a(72): c(72) = a(72) Else GoTo 720

a(71) = (141*s1 - 54*a(94) - 36*a(95) + 30*a(97) + 30*a(98) - 6*a(99) + 6*a(100) - 45*a(110) - 36*a(114) - 69*a(115) +
                                      - 36*a(118) - 72*a(119) - 117*a(120) - 15*a(122) - 39*a(123) - 87*a(124) - 144*a(125)) / 15
If a(71) <= 0 Or a(71) > 125 Or CInt(a(71)) <> a(71) Then GoTo 710
If b(a(71)) = 0 Then b(a(71)) = a(71): c(71) = a(71) Else GoTo 710


a(55) = 126 - a(71): If b(a(55)) = 0 Then b(a(55)) = a(55): c(55) = a(55) Else GoTo 550
a(54) = 126 - a(72): If b(a(54)) = 0 Then b(a(54)) = a(54): c(54) = a(54) Else GoTo 540
a(53) = 126 - a(73): If b(a(53)) = 0 Then b(a(53)) = a(53): c(53) = a(53) Else GoTo 530
a(52) = 126 - a(74): If b(a(52)) = 0 Then b(a(52)) = a(52): c(52) = a(52) Else GoTo 520
a(51) = 126 - a(75): If b(a(51)) = 0 Then b(a(51)) = a(51): c(51) = a(51) Else GoTo 510
a(50) = 126 - a(76): If b(a(50)) = 0 Then b(a(50)) = a(50): c(50) = a(50) Else GoTo 500
a(49) = 126 - a(77): If b(a(49)) = 0 Then b(a(49)) = a(49): c(49) = a(49) Else GoTo 490
a(48) = 126 - a(78): If b(a(48)) = 0 Then b(a(48)) = a(48): c(48) = a(48) Else GoTo 480
a(47) = 126 - a(79): If b(a(47)) = 0 Then b(a(47)) = a(47): c(47) = a(47) Else GoTo 470
a(46) = 126 - a(80): If b(a(46)) = 0 Then b(a(46)) = a(46): c(46) = a(46) Else GoTo 460
    
a(34) = 126 - a(92): If b(a(34)) = 0 Then b(a(34)) = a(34): c(34) = a(34) Else GoTo 340
a(33) = 126 - a(93): If b(a(33)) = 0 Then b(a(33)) = a(33): c(33) = a(33) Else GoTo 330
a(32) = 126 - a(94): If b(a(32)) = 0 Then b(a(32)) = a(32): c(32) = a(32) Else GoTo 320

     For j90 = m1 To m2
     If b(j90) = 0 Then b(j90) = j90: c(90) = j90 Else GoTo 900
     a(90) = j90

     a(89) = a(93) - a(115) + a(123) + (-2*a(90) + 2*a(95) + 2*a(98) - 2*a(99) + a(108) - a(110) +
                                                           - a(112)  - a(114)  + a(118) - a(120) + a(122) + a(124)) / 3
     If a(89) <= 0 Or a(89) > 125 Or CInt(a(89)) <> a(89) Then GoTo 890
     If b(a(89)) = 0 Then b(a(89)) = a(89): c(89) = a(89) Else GoTo 890
     a(88) = -2 * a(89) - 2 * a(90) + a(93) + 2 * a(94) + 2 * a(95) + a(111) - a(115) - a(121) + a(125)
     If a(88) <= 0 Or a(88) > 125 Then GoTo 880
     If b(a(88)) = 0 Then b(a(88)) = a(88): c(88) = a(88) Else GoTo 880
     a(87) = a(89) + a(92) - a(94): If a(87) <= 0 Or a(87) > 125 Then GoTo 870
     If b(a(87)) = 0 Then b(a(87)) = a(87): c(87) = a(87) Else GoTo 870
     a(86) = 315 - a(87) - a(88) - a(89) - a(90)
     If a(86) <= 0 Or a(86) > 125 Then GoTo 860
     If b(a(86)) = 0 Then b(a(86)) = a(86): c(86) = a(86) Else GoTo 860
     a(85) = -2898 - a(90) - a(97) - a(98) + (18*a(94) + 7*a(95) + 7*a(99) - 2*a(100) + 10*a(110) + 12*a(114) +
                   + 18*a(115) + 12*a(118) + 24*a(119) + 34*a(120) + 10*a(122) + 18*a(123) + 34*a(124) + 48*a(125)) / 5
     If a(85) <= 0 Or a(85) > 125 Or CInt(a(85)) <> a(85) Then GoTo 850
     If b(a(85)) = 0 Then b(a(85)) = a(85): c(85) = a(85) Else GoTo 850
     a(84) = a(85) - a(88) + a(90) - a(92) + a(95) - a(96) + a(100)
     If a(84) <= 0 Or a(84) > 125 Then GoTo 840
     If b(a(84)) = 0 Then b(a(84)) = a(84): c(84) = a(84) Else GoTo 840
     a(83) = 945 - a(87) - a(94) - 1.5 * (a(85) + a(90) + a(95) + a(97) + a(98) + a(99) + 2 * a(100))
     If a(83) <= 0 Or a(83) > 125 Or CInt(a(83)) <> a(83) Then GoTo 830
     If b(a(83)) = 0 Then b(a(83)) = a(83): c(83) = a(83) Else GoTo 830
     a(82) = (315 - a(83) - a(84) - a(85) + a(86) - a(88) + a(91) - a(94) + a(96) - a(100)) / 2
     If a(82) <= 0 Or a(82) > 125 Or CInt(a(82)) <> a(82) Then GoTo 820
     If b(a(82)) = 0 Then b(a(82)) = a(82): c(82) = a(82) Else GoTo 820
     a(81) = 315 - a(82) - a(83) - a(84) - a(85)
     If a(81) <= 0 Or a(81) > 125 Then GoTo 810
     If b(a(81)) = 0 Then b(a(81)) = a(81): c(81) = a(81) Else GoTo 810

     a(70) = 63 + a(81) - a(95) + a(116) - a(120)
     If a(70) <= 0 Or a(70) > 125 Then GoTo 700
     If b(a(70)) = 0 Then b(a(70)) = a(70): c(70) = a(70) Else GoTo 700
     a(69) = 63 + a(82) - a(94)
     If a(69) <= 0 Or a(69) > 125 Then GoTo 690
     If b(a(69)) = 0 Then b(a(69)) = a(69): c(69) = a(69) Else GoTo 690
     a(68) = -63 + a(69) + a(70) - a(81) - a(92) + a(94) + a(95) - a(116) + a(120)
     If a(68) <= 0 Or a(68) > 125 Then GoTo 680
     If b(a(68)) = 0 Then b(a(68)) = a(68): c(68) = a(68) Else GoTo 680
     a(67) = 63 + a(84) - a(92): If a(67) <= 0 Or a(67) > 125 Then GoTo 670
     If b(a(67)) = 0 Then b(a(67)) = a(67): c(67) = a(67) Else GoTo 670
     a(66) = 315 - a(67) - a(68) - a(69) - a(70)
     If a(66) <= 0 Or a(66) > 125 Then GoTo 660
     If b(a(66)) = 0 Then b(a(66)) = a(66): c(66) = a(66) Else GoTo 660
     
     a(60) = 126 - a(66): If b(a(60)) = 0 Then b(a(60)) = a(60): c(60) = a(60) Else GoTo 600
     a(59) = 126 - a(67): If b(a(59)) = 0 Then b(a(59)) = a(59): c(59) = a(59) Else GoTo 590
     a(58) = 126 - a(68): If b(a(58)) = 0 Then b(a(58)) = a(58): c(58) = a(58) Else GoTo 580
     a(57) = 126 - a(69): If b(a(57)) = 0 Then b(a(57)) = a(57): c(57) = a(57) Else GoTo 570
     a(56) = 126 - a(70): If b(a(56)) = 0 Then b(a(56)) = a(56): c(56) = a(56) Else GoTo 560
     
     a(45) = 126 - a(81): If b(a(45)) = 0 Then b(a(45)) = a(45): c(45) = a(45) Else GoTo 450
     a(44) = 126 - a(82): If b(a(44)) = 0 Then b(a(44)) = a(44): c(44) = a(44) Else GoTo 440
     a(43) = 126 - a(83): If b(a(43)) = 0 Then b(a(43)) = a(43): c(43) = a(43) Else GoTo 430
     a(42) = 126 - a(84): If b(a(42)) = 0 Then b(a(42)) = a(42): c(42) = a(42) Else GoTo 420
     a(41) = 126 - a(85): If b(a(41)) = 0 Then b(a(41)) = a(41): c(41) = a(41) Else GoTo 410
     a(40) = 126 - a(86): If b(a(40)) = 0 Then b(a(40)) = a(40): c(40) = a(40) Else GoTo 400
     a(39) = 126 - a(87): If b(a(39)) = 0 Then b(a(39)) = a(39): c(39) = a(39) Else GoTo 390
     a(38) = 126 - a(88): If b(a(38)) = 0 Then b(a(38)) = a(38): c(38) = a(38) Else GoTo 380
     a(37) = 126 - a(89): If b(a(37)) = 0 Then b(a(37)) = a(37): c(37) = a(37) Else GoTo 370
     a(36) = 126 - a(90): If b(a(36)) = 0 Then b(a(36)) = a(36): c(36) = a(36) Else GoTo 360

     n9 = n9 + 1: n10 = n10 + 1

'    GoSub 1740                 'Print results (selected numbers)
     GoSub 1750                 'Print results (planes 11, 12, 13, 14 and 15)
'    GoSub 1760                 'Print results (3d)

    b(c(36)) = 0: c(36) = 0
360 b(c(37)) = 0: c(37) = 0
370 b(c(38)) = 0: c(38) = 0
380 b(c(39)) = 0: c(39) = 0
390 b(c(40)) = 0: c(40) = 0
400 b(c(41)) = 0: c(41) = 0
410 b(c(42)) = 0: c(42) = 0
420 b(c(43)) = 0: c(43) = 0
430 b(c(44)) = 0: c(44) = 0
440 b(c(45)) = 0: c(45) = 0
450 b(c(56)) = 0: c(56) = 0
560 b(c(57)) = 0: c(57) = 0
570 b(c(58)) = 0: c(58) = 0
580 b(c(59)) = 0: c(59) = 0
590 b(c(60)) = 0: c(60) = 0
600 b(c(66)) = 0: c(66) = 0
660 b(c(67)) = 0: c(67) = 0
670 b(c(68)) = 0: c(68) = 0
680 b(c(69)) = 0: c(69) = 0
690 b(c(70)) = 0: c(70) = 0
700 b(c(81)) = 0: c(81) = 0
810 b(c(82)) = 0: c(82) = 0
820 b(c(83)) = 0: c(83) = 0
830 b(c(84)) = 0: c(84) = 0
840 b(c(85)) = 0: c(85) = 0
850 b(c(86)) = 0: c(86) = 0
860 b(c(87)) = 0: c(87) = 0
870 b(c(88)) = 0: c(88) = 0
880 b(c(89)) = 0: c(89) = 0
890 b(c(90)) = 0: c(90) = 0
900 Next j90

    b(c(32)) = 0: c(32) = 0
320 b(c(33)) = 0: c(33) = 0
330 b(c(34)) = 0: c(34) = 0
340 b(c(46)) = 0: c(46) = 0
460 b(c(47)) = 0: c(47) = 0
470 b(c(48)) = 0: c(48) = 0
480 b(c(49)) = 0: c(49) = 0
490 b(c(50)) = 0: c(50) = 0
500 b(c(51)) = 0: c(51) = 0
510 b(c(52)) = 0: c(52) = 0
520 b(c(53)) = 0: c(53) = 0
530 b(c(54)) = 0: c(54) = 0
540 b(c(55)) = 0: c(55) = 0
550 b(c(71)) = 0: c(71) = 0
710 b(c(72)) = 0: c(72) = 0
720 b(c(73)) = 0: c(73) = 0
730 b(c(74)) = 0: c(74) = 0
740 b(c(75)) = 0: c(75) = 0
750 b(c(76)) = 0: c(76) = 0
760 b(c(77)) = 0: c(77) = 0
770 b(c(78)) = 0: c(78) = 0
780 b(c(79)) = 0: c(79) = 0
790 b(c(80)) = 0: c(80) = 0
800 b(c(92)) = 0: c(92) = 0
920 b(c(93)) = 0: c(93) = 0
930 b(c(94)) = 0: c(94) = 0
940 Next j94
    
    b(c(31)) = 0: c(31) = 0
310 b(c(35)) = 0: c(35) = 0
350 b(c(91)) = 0: c(91) = 0
910 b(c(95)) = 0: c(95) = 0
950 Next j95

    b(c(29)) = 0: c(29) = 0
290 b(c(30)) = 0: c(30) = 0
300 b(c(61)) = 0: c(61) = 0
610 b(c(62)) = 0: c(62) = 0
620 b(c(64)) = 0: c(64) = 0
640 b(c(65)) = 0: c(65) = 0
650 b(c(96)) = 0: c(96) = 0
960 b(c(97)) = 0: c(97) = 0
970 Next j97
    
    b(c(28)) = 0: c(28) = 0
280 b(c(98)) = 0: c(98) = 0
980 Next j98
    
    b(c(27)) = 0: c(27) = 0
270 b(c(99)) = 0: c(99) = 0
990 Next j99
     
     b(c(26)) = 0: c(26) = 0
260  b(c(100)) = 0: c(100) = 0

1000 Next j100

Return

'    Print results (selected numbers)

1740 For i1 = 1 To 125
         Cells(n9, i1).Value = a(i1)
     Next i1
     Cells(n9, 126).Value = j10
     Cells(n9, 127).Value = n10
     Return

'    Print results (planes 11, 12, 13, 14 and 15)

1750 n2 = n2 + 1
     If n2 = 7 Then
         n2 = 1: k1 = k1 + 30: k2 = 1
     Else
         If n9 > 1 Then k2 = k2 + 6
     End If
       
     For i0 = 1 To 5
         i3 = (5 - i0) * 25
         For i1 = 1 To 5
             For i2 = 1 To 5
                 i3 = i3 + 1
                 Cells(k1 + i1 + (i0 - 1) * 6, k2 + i2).Value = a(i3)
             Next i2
         Next i1
         If i0 = 1 Then
             Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0) + ", C" + CStr(n9)
         Else
             Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0)
         End If
     Next i0
    
     Return

'    Print results (3d)
    
1760 n2 = n2 + 1
     If n2 = 4 Then
         n2 = 1: k1 = k1 + 46: k2 = 1
     Else
         If n9 > 1 Then k2 = k2 + 22
     End If
       
     For i0 = 1 To 5
         i3 = (5 - i0) * 25
         For i1 = 1 To 5
             For i2 = 1 To 5
                 i3 = i3 + 1
                 Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 9, k2 + 9 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
             Next i2
         Next i1
     Next i0

     Return

End Sub


'
' Format all Cubes
'

Sub Macro2()

y = MsgBox("Locked", vbCritical, "Routine Macro2, Format all Cubes")
End

    k1 = 2: k2 = 2: n2 = 1: n9 = 48
    
    Range(Cells(2, 2), Cells(46, 22)).Select: Selection.Copy

    For i1 = 2 To n9
    
        n2 = n2 + 1
        If n2 = 5 Then
            n2 = 1: k1 = k1 + 46: k2 = 2
        Else
            k2 = k2 + 22
        End If
             
        Range(Cells(k1, k2), Cells(k1, k2)).Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
    Next i1
    
    Application.CutCopyMode = False
    Range("A1").Select
    
End Sub

'
' Make Bitmaps (MSO Diagonal Format not transferable to HTML)
'

Sub Macro3()

y = MsgBox("Locked", vbCritical, "Routine Macro3, Make Bitmaps")
End
  
    k1 = 2: k2 = 2: n2 = 0: n9 = 48
    sht1$ = "Klad1"
        
    For i1 = 1 To n9
       
        n2 = n2 + 1
        If n2 = 5 Then
            n2 = 1: k1 = k1 + 46: k2 = 2
        Else
            If i1 > 1 Then k2 = k2 + 22
        End If
        
        Worksheets(sht1$).Range(Cells(k1, k2), Cells(k1 + 45, k2 + 21)).CopyPicture xlScreen, xlBitmap
        Worksheets(sht1$).Paste Destination:=Worksheets(sht1$).Range(Cells(k1, k2), Cells(k1, k2))
             
    Next i1
        
    Range("A1").Select
    
End Sub

Vorige Pagina About the Author