Option Explicit
 
Dim quadrat(100, 100) As Long
Dim ord As Long
 
Private Sub mod4()
    Dim a As Long, b As Long, erg As Long, zw As Long, i As Long, j As Long
 
    zw = ord / 4
    For i = 1 To ord
        For j = 1 To ord
            a = ((i - 1) / (zw))
            b = ((j - 1) / (zw))
            erg = a * 4 + b + 1
            Select Case erg
                Case 1, 4, 6, 7, 10, 11, 13, 16: quadrat(i, j) = (i - 1) * ord _
                  + j
                Case Else: quadrat(ord + 1 - i, ord + 1 - j) = (i - 1) * ord + j
            End Select
        Next j
    Next i
End Sub
 
Private Sub oddmod2()
    Dim x As Long, y As Long, anz As Long, zw As Long, i As Long
 
    x = (ord / 2 + 1) / 2
    y = 1
    anz = 0
    For i = 1 To (ord * ord / 4)
        quadrat(y, x) = i
        anz = anz + 1
        If (anz Mod (ord / 2) = 0) Then
            y = y + 1
        Else
            If (x = ord / 2) Then x = 1 Else x = x + 1
            If (y = 1) Then y = ord / 2 Else y = y - 1
        End If
    Next i
 
    x = (ord / 2 + 1) / 2 + (ord / 2)
    y = 1 + (ord / 2)
    anz = 0
    For i = 1 To (ord * ord / 4)
        quadrat(y, x) = i + (ord * ord / 4)
        anz = anz + 1
        If (anz Mod (ord / 2) = 0) Then
            y = y + 1
        Else
            If (x = ord) Then x = ord / 2 + 1 Else x = x + 1
            If (y = ord / 2 + 1) Then y = ord Else y = y - 1
        End If
    Next i
 
    x = (ord / 2 + 1) / 2 + (ord / 2)
    y = 1
    anz = 0
    For i = 1 To (ord * ord / 4)
        quadrat(y, x) = i + 2 * (ord * ord / 4)
        anz = anz + 1
        If (anz Mod (ord / 2) = 0) Then
            y = y + 1
        Else
            If (x = ord) Then x = ord / 2 + 1 Else x = x + 1
            If (y = 1) Then y = ord / 2 Else y = y - 1
        End If
    Next i
 
    x = (ord / 2 + 1) / 2
    y = 1 + (ord / 2)
    anz = 0
    For i = 1 To (ord * ord / 4)
        quadrat(y, x) = i + 3 * (ord * ord / 4)
        anz = anz + 1
        If (anz Mod (ord / 2) = 0) Then
            y = y + 1
        Else
            If (x = ord / 2) Then x = 1 Else x = x + 1
            If (y = ord / 2 + 1) Then y = ord Else y = y - 1
        End If
    Next i
 
    For i = 1 To (ord / 3)
        zw = quadrat(i, i)
        quadrat(i, i) = quadrat(ord / 2 + i, i)
        quadrat(ord / 2 + i, i) = zw
        If (i <> ord / 3) Then
            zw = quadrat(ord / 2 + 1 - i, i)
            quadrat(ord / 2 + 1 - i, i) = quadrat(ord + 1 - i, i)
            quadrat(ord + 1 - i, i) = zw
        End If
    Next i
End Sub
 
Private Sub ausgabe()
    Dim i As Long, j As Long
 
    For i = 1 To ord
        For j = 1 To ord
            Me.Print quadrat(i, j),
        Next j
        Me.Print vbCrLf
    Next i
End Sub
 
Private Sub Form_Activate()
    ord = CLng(InputBox("Ordnung:", , "6"))
 
    If ord < 3 Then
        MsgBox "Ordnung muß mindestens 3 sein !", vbInformation
        Unload Me
        Exit Sub
    End If
 
    If (ord Mod 2 = 1) Then
        MsgBox "Ordnung muß gerade sein !", vbInformation
        Unload Me
        Exit Sub
    End If
 
    If (ord Mod 4 = 0) Then
        mod4
    Else
        oddmod2
    End If
    ausgabe
End Sub

Gru? Michi aus Hannover

1 + 1 = 3 f?r hinreichend gro?e 1