Нужно найти все возможные перестановки элементов массива

    Dim N As Integer
    Dim X () As Integer
    
    Private Sub Perestanovki ()
       Dim i As Integer
    
       N = CInt (InputBox ("Введите N"))
       ReDim X (N)
       For i = 1 To N
          X (i) = i
       Next
       PRGenerate 0
    End Sub
    
    Private Sub PRGenerate (ByVal k As Integer)
       Dim i As Integer
    
       If k = N Then
          For i = 1 To N
             txtOut.Text = txtOut.Text & CStr (X (i))
          Next
          txtOut.Text = txtOut.Text & vbCrLf
       Else
          For i = k + 1 To N
             Swap X (k + 1), X (i)
             PRGenerate k + 1
             Swap X (k + 1), X (i)
          Next
       End If
    End Sub
    
    Private Sub Swap (ByRef a As Integer, ByRef b As Integer)
       Dim c As Integer
    
       c = a
       a = b
       b = c
    End Sub

 Dim X () As Integer 
    Dim Counter () As Integer 
    Dim Out() As Integer 
    Dim K As Integer 
    Dim N As Integer 
     
    Private Sub Razm () 
    Dim i As Integer 
     
    N = CInt(InputBox("Введите N")) 
    K = CInt(InputBox("Введите K")) 
     
    K = K + 1 
     
    ReDim X(N) 
       ReDim Out(K) 
     
    For i = 1 To N 
           X(i) = i 
    Next 
    txtOut.Text = "" 
     
    ReDim Counter(K) 
    Counter(0) = 1 
     
    RazmSochGenerate 1 
    End Sub 
     
    Private Sub RazmSochGenerate () 
    Dim i As Integer 
    Dim j As Integer 
    Dim n1 As Integer 
    Dim X1() As Integer 
     
       If c = K Then 
           
          X1 = X 
           
          For i = 1 To K - 1 
             n1 = 0 
             For j = 1 To N 
                If X1(j) <> 0 Then n1 = n1 + 1 
                If n1 = Counter(i) Then 
                   Out(i) = X1(j) 
                   X1(j) = 0 
                   Exit For 
                End If 
             Next 
          Next 
          PRGenerate 0 
       Else 
          For Counter(c) = Counter(c - 1) To N - c + 1 
             RazmSochGenerate c + 1 
          Next 
       End If 
    End Sub 
     
    Private Sub PRGenerate (ByVal k As Integer) 
       Dim i As Integer 
     
       If k = N Then 
          For i = 1 To N 
             txtOut.Text = txtOut.Text & CStr (Out (i)) 
          Next 
          txtOut.Text = txtOut.Text & vbCrLf 
       Else 
          For i = k + 1 To N 
             Swap Out (k + 1), Out (i) 
             PRGenerate k + 1 
             Swap Out (k + 1), Out (i) 
          Next 
       End If 
    End Sub 
     
    Private Sub Swap (ByRef a As Integer, ByRef b As Integer) 
       Dim c As Integer 
     
       c = a 
       a = b 
       b = c 
    End Sub