aqui lo que me mandaste
prueba esta solucion y me cuentas , esta al medio , haber si despues me mandas el juegito je je
Const Gris As Long = &HFFFFFF
Private SudokuGrid(81) As Integer
Private SudokuTemp(81) As String
Private SudokuSolution(81) As String
Private Sub cmdGenerar_Click()
While Not CreateSudokuGrid()
Wend
lblDone.Visible = False
SolutionShown = False
If SolutionShown Then
For i = 1 To 81
Text1(i).Text = SudokuTemp(i)
Next i
Else
For i = 1 To 81
SudokuTemp(i) = Text1(i).Text
Text1(i).Text = SudokuSolution(i)
Next
End If
End Sub
Private Function CreateSudokuGrid() As Boolean
Dim b, i, j, k As Integer
Dim numRand As Integer
Dim ValIsOK(9) As Boolean
Dim valsOK As Integer
valsOK = 0
lblConfiguring.Visible = True
For i = 1 To 81
Text1(i).Text = ""
Text1(i).BackColor = Gris
Text1(i).Visible = False
SudokuSolution(i) = ""
Next i
lblConfiguring.Visible = True
lblConfiguring.Refresh
For i = 1 To 81
If True Then
valsOK = GetValidVals(i, ValIsOK)
If valsOK <= 0 Then
CreateSudokuGrid = False
End If
-------------------------------------------------
esto debes cambiar
-------------------------------------------------
' numRand = Int(Rnd(valsOK)) + 1
'k = 0
'For j = 1 To 9
'If ValIsOK(j) Then
' k = k + 1
'If k = numRand Then
' Exit For
'End If
'End If
'Next j
-------------------------------------------------------
hasta aqui
--------------------------------------------
Randomize
numRand = Int( Rnd * valsOK+1)
k = 0
For j = 0 To 8
If ValIsOK(j) Then
k = k + 1
If k = numRand Then
Exit For
End If
End If
Next j
esto es nuevo verifica y me cuentas habia un problema de matrices y otro que un numero nunca se tomaba
---------------------------------------------------------
Text1(i).Text = CStr(j)
Text1(i).BackColor = Gris
End If
Next i
lblConfiguring.Visible = False
For i = 1 To 81
SudokuSolution(i) = Text1(i).Text
numRand = Rnd(CInt(3) + 1) + 1
If numRand > 1 Then
Text1(i).Text = ""
Text1(i).BackColor = Gris
Text1(i).Enabled = True
Else
Text1(i).Enabled = False
End If
Text1(i).Visible = True
Next i
CreateSudokuGrid = True
End Function
Private Function GetValidVals(ByVal Location As Integer, ByRef ValidVals() As Boolean) As Integer
Dim i, j, k As Integer
Dim row, col As Integer
Dim numStr As String
Dim numOK As Boolean
Dim retVal As Integer
retVal = 0
For i = 1 To 9
numOK = True
numStr = CStr(i)
For j = 1 To 9
k = (Int((Location - 1) / 9) * 9) + j
If Text1(k).Text = numStr Then
numOK = False
Exit For
End If
Next j
If numOK Then
For j = 1 To 9
k = (((Location - 1) Mod 9) + 1) + ((j - 1) * 9)
If Text1(k).Text = numStr Then
numOK = False
Exit For
End If
Next j
End If
If numOK Then
row = Int(Int((Location - 1) / 9) / 3)
col = Int(((Location - 1) Mod 9) / 3)
For j = 1 To 9
k = (((row * Rnd) + Int((j - 1) / 9)) * 9) + (col * 9) + ((j - 1) Mod 3) + 1
If Text1(k).Text = numStr Then
numOK = False
Exit For
End If
Next j
End If
ValidVals(i) = numOK
If numOK Then
retVal = retVal
End If
Next i
GetValidVals = retVal
End Function