' Perfect Diagonal Magic Cubes (m >= 10, m Mod 3 ≠ 0)

' Tested with Office 2007 under Windows 7

```Sub Perfect10()

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

m = 10: N = 8

For k = 0 To m - 1

If k < m - 1 - k Then k1 = k Else k1 = m - 1 - k

For i = 0 To m - 1
i11 = i11 + 1

If i < m - 1 - i Then i1 = i Else i1 = m - 1 - i

For j = 0 To m - 1
j11 = j11 + 1: j12 = j12 + 1

If j < m - 1 - j Then j1 = j Else j1 = m - 1 - j

v = 4*Int(2*i/m) + 2*Int(2*j/m) + ((Int(2*i/m) + Int(2*j/m) + Int(2*k/m)) Mod 2)  '(0 <= v <= 7),

z1 = (i1 + j1 - 2 * k1)
While z1 < 0
z1 = z1 + m / 2
Wend

z = z1 Mod (m / 2)

cijk = (2 * i1 + j1 + k1) Mod (m / 2) ' 0 <= bijk < m/2
dijk = (i1 + 2 * j1 + k1) Mod (m / 2) ' 0 <= cijk < m/2
eijk = (i1 + j1 + 2 * k1) Mod (m / 2) ' 0 <= dijk < m/2

x = F8(v, z, N)

bijk = D8(x, i1, j1, k1, i, j, k, m)

'   Print Cube

If j11 = m + 1 Then j11 = 1
If j12 = m ^ 2 + 1 Then j12 = 1: i11 = i11 + 1

aijk = bijk * (m / 2) ^ 3 + cijk * (m / 2) ^ 2 + dijk * (m / 2) + eijk + 1

Cells(i11 + 1, j11 + 1).Value = aijk

Next j
Next i
Next k

End

End Sub

Function F8(v, z, N)

If Int(v / 2) = v / 2 Then    'v is even

Select Case z

Case 0:    F8 = v
Case 1:    F8 = v + 1
Case 2:    F8 = N / 2 - 1 - v / 2
Case 3:    F8 = N - 1 - v / 2
Case 4, 6: F8 = N - 1 - v
Case 5, 7: F8 = v

End Select

Else                          'v is odd

Select Case z

Case 0:    F8 = v
Case 1:    F8 = v - 1
Case 2:    F8 = N - 1 - (v - 1) / 2
Case 3:    F8 = N / 2 - 1 - (v - 1) / 2
Case 4, 6: F8 = N - 1 - v
Case 5, 7: F8 = v

End Select

End If

End Function

Function D8(x, i1, j1, k1, i, j, k, m)

fl1 = 0: fl2 = 0

If j1 = (k1 + 1) Mod (m / 2) And i >= m / 2 And i1 = k1 Then fl1 = 1: GoTo 10
If i1 = (k1 + 1) Mod (m / 2) And j >= m / 2 And j1 = k1 Then fl1 = 1: GoTo 10
If j1 = (k1 + (m + 2) / 4) Mod (m / 2) And i >= m / 2 And i1 = j1 Then fl1 = 1: GoTo 10

k2 = (k1 - 1) Mod (m / 2)
If k2 < 0 Then k2 = (k1 - 1 + m / 2) Mod (m / 2)

If j1 = (k1 + 1) Mod (m / 2) And i >= m / 2 And i1 = k2 Then fl1 = 1: GoTo 10
If i1 = (k1 + 1) Mod (m / 2) And j >= m / 2 And j1 = k2 Then fl1 = 1: GoTo 10

i2 = (j1 - 1) Mod (m / 2)
If i2 < 0 Then i2 = (j1 - 1 + m / 2) Mod (m / 2)

If j1 = (k1 + (m + 2) / 4) Mod (m / 2) And i >= m / 2 And i1 = i2 Then fl1 = 1: GoTo 10

10

If fl1 = 1 Then

D8 = x + (-1) ^ x

Else

D8 = x

End If

End Function
```