


'UserForm1
'A) Windows XP® Office 2003® Normal Referance List
'A1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'A2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'A3) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\STDOLE2.TLB
'A4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'A5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'A6) Name: OWC11, Description: Microsoft Office Web Components 11.0, FullPath: C:\Program Files\Common Files\Microsoft Shared\Web Components\11\OWC11.DLL [Picture: 1]
'B1) Image1, Label1, Label2
'B2) ComboBox1 , CommandButton1
'B3) Spreadsheet1
'B4) CommandButton2, CommandButton3, CommandButton4
Dim i As Integer, ii As Integer
Dim Sabit81(1 To 9, 1 To 9)
Dim Sabit324(1 To 36, 1 To 9)
Dim Sabit324Seçimi(1 To 2, 1 To 9)
Dim Rastgele1(1 To 1, 1 To 1)
Dim Rastgele81(1 To 9, 1 To 9)
Dim Tablo1(1 To 9, 1 To 9)
Dim RastgeleC1(1 To 1, 1 To 1)
Dim RastgeleC4(1 To 1, 1 To 1)
Dim RastgeleC7(1 To 1, 1 To 1)
Dim Tablo2(1 To 9, 1 To 9)
Dim RastgeleR1(1 To 1, 1 To 1)
Dim RastgeleR4(1 To 1, 1 To 1)
Dim RastgeleR7(1 To 1, 1 To 1)
Dim Tablo3(1 To 9, 1 To 9)
Dim TabloSudoku(1 To 9, 1 To 9)
Dim Alan As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Excel Sudoku"
Call EkranDüzenle
Private Sub CommandButton1_Click()
On Error Resume Next
Call Sabit81Düzenle
Call Sabit324Düzenle
Call Rastgele1Düzenle
Call Sabit324SeçimiDüzenle
Call Tablo1Düzenle
Call RastgeleC147Düzenle
Call Tablo2Düzenle
Call RastgeleR147Düzenle
Call Tablo3Düzenle
Call Rastgele81Düzenle
Call TabloSudokuDüzenle
With Spreadsheet1
.ActiveSheet.Unprotect
.ActiveSheet.Range("A1:I9").ClearContents
For i = 1 To 9
For ii = 1 To 9
If TabloSudoku(i, ii) = "" Then
With .ActiveSheet.Range("A1:I9")
.Cells(i, ii) = ""
.Cells(i, ii).Font.Color = vbBlue
.Cells(i, ii).Locked = False
End With
Else
With .ActiveSheet.Range("A1:I9")
.Cells(i, ii) = TabloSudoku(i, ii)
.Cells(i, ii).Font.Color = vbBlack
.Cells(i, ii).Locked = True
End With
End If
Next ii
Next i
.ActiveSheet.Protect
End With
End SubPrivate Sub CommandButton2_Click()
On Error Resume Next
With Spreadsheet1
.ActiveSheet.Unprotect
For i = 1 To 9
For ii = 1 To 9
If Tablo3(i, ii) = .ActiveSheet.Range("A1:I9").Cells(i, ii).Value Then
.ActiveSheet.Range("A1:I9").Cells(i, ii).Select
Else
.ActiveSheet.Range("A1:I9").Cells(i, ii).Select
.ActiveSheet.Range("A1:I9").Cells(i, ii) = ""
End If
Next ii
Next i
.ActiveSheet.Protect
End With
End SubPrivate Sub CommandButton3_Click()
On Error Resume Next
With Spreadsheet1
.ActiveSheet.Unprotect
For i = 1 To 9
For ii = 1 To 9
.ActiveSheet.Range("A1:I9").Cells(i, ii).Select
.ActiveSheet.Range("A1:I9").Cells(i, ii) = Tablo3(i, ii)
Next ii
Next i
.ActiveSheet.Protect
End With
End SubPrivate Sub CommandButton4_Click()
On Error Resume Next
Me.PrintForm
Private Sub EkranDüzenle()
On Error Resume Next
With Me
.Height = 452
.Width = 336
.BackColor = VBA.vbWhite
.Picture = Resim(URL1)
'.Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = Resim(URL2)
'.Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With ComboBox1
.Left = 6
.Top = 36
.Height = 24
.Width = 210
.AddItem "1 - Extremely Easy [En kolay]"
.AddItem "2 - Very Easy [Çok kolay]"
.AddItem "3 - Easy [Kolay]"
.AddItem "4 - Medium [Orta]"
.AddItem "5 - Hard [Zor]"
.AddItem "6 - Very Hard [Çok Zor]"
.AddItem "7 - Extremely Hard [En Zor]"
.ListIndex = 0
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.BackColor = &H80000018
End With
With CommandButton1
.Top = 36
.Width = 102
.Left = 222
.Height = 24
.Caption = "SUDOKU"
.Font.Bold = True
.ForeColor = &H808000
End With
With Spreadsheet1
.Sheets(1).Select
.Left = 6
.Top = 66
.Height = 325
.Width = 318
With .ActiveWindow
.DisplayHeadings = False
.DisplayColumnHeadings = False
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayRowHeadings = False
.DisplayVerticalScrollBar = False
.EnableResize = False
.ViewableRange = "A1:I9"
.DisplayWorkbookTabs = False
End With
.Columns.ColumnWidth = 6
.Rows.RowHeight = 36
.DisplayTitleBar = False
.DisplayToolbar = False
With .ActiveSheet.Range("A1:I9")
.ClearContents
.Font.Bold = True
.Font.Color = vbBlue
.Font.Size = 24
.Locked = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.MergeCells = False
End With
.Calculation = xlCalculationManual
.ActiveSheet.Protect
For i = 1 To 9
If i = 1 Then Alan = "A1:C3"
If i = 2 Then Alan = "A4:C6"
If i = 3 Then Alan = "A7:C9"
If i = 4 Then Alan = "D1:F3"
If i = 5 Then Alan = "D4:F6"
If i = 6 Then Alan = "D7:F9"
If i = 7 Then Alan = "G1:I3"
If i = 8 Then Alan = "G4:I6"
If i = 9 Then Alan = "G7:I9"
With .ActiveSheet.Range(Alan)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 14
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 14
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 14
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 14
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 14
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 14
End With
End With
Next i
End With
With CommandButton2
.Top = 396
.Width = 102
.Left = 6
.Height = 24
.Caption = "Kontrol [Control]"
.Font.Bold = True
.ForeColor = &H808000
End With
With CommandButton3
.Top = 396
.Width = 102
.Left = 114
.Height = 24
.Caption = "Çöz [Resolved]"
.Font.Bold = True
.ForeColor = &H808000
End With
With CommandButton4
.Top = 396
.Width = 102
.Left = 222
.Height = 24
.Caption = "Yazdır [Print]"
.Font.Bold = True
.ForeColor = &H808000
End With
End SubPrivate Sub Sabit81Düzenle()
On Error Resume Next
Sabit81(1, 1) = 1: Sabit81(1, 2) = 2: Sabit81(1, 3) = 3: Sabit81(1, 4) = 4: Sabit81(1, 5) = 5: Sabit81(1, 6) = 6: Sabit81(1, 7) = 7: Sabit81(1, 8) = 8: Sabit81(1, 9) = 9
Sabit81(2, 1) = 4: Sabit81(2, 2) = 5: Sabit81(2, 3) = 6: Sabit81(2, 4) = 7: Sabit81(2, 5) = 8: Sabit81(2, 6) = 9: Sabit81(2, 7) = 1: Sabit81(2, 8) = 2: Sabit81(2, 9) = 3
Sabit81(3, 1) = 7: Sabit81(3, 2) = 8: Sabit81(3, 3) = 9: Sabit81(3, 4) = 1: Sabit81(3, 5) = 2: Sabit81(3, 6) = 3: Sabit81(3, 7) = 4: Sabit81(3, 8) = 5: Sabit81(3, 9) = 6
Sabit81(4, 1) = 2: Sabit81(4, 2) = 3: Sabit81(4, 3) = 4: Sabit81(4, 4) = 5: Sabit81(4, 5) = 6: Sabit81(4, 6) = 7: Sabit81(4, 7) = 8: Sabit81(4, 8) = 9: Sabit81(4, 9) = 1
Sabit81(5, 1) = 5: Sabit81(5, 2) = 6: Sabit81(5, 3) = 7: Sabit81(5, 4) = 8: Sabit81(5, 5) = 9: Sabit81(5, 6) = 1: Sabit81(5, 7) = 2: Sabit81(5, 8) = 3: Sabit81(5, 9) = 4
Sabit81(6, 1) = 8: Sabit81(6, 2) = 9: Sabit81(6, 3) = 1: Sabit81(6, 4) = 2: Sabit81(6, 5) = 3: Sabit81(6, 6) = 4: Sabit81(6, 7) = 5: Sabit81(6, 8) = 6: Sabit81(6, 9) = 7
Sabit81(7, 1) = 3: Sabit81(7, 2) = 4: Sabit81(7, 3) = 5: Sabit81(7, 4) = 6: Sabit81(7, 5) = 7: Sabit81(7, 6) = 8: Sabit81(7, 7) = 9: Sabit81(7, 8) = 1: Sabit81(7, 9) = 2
Sabit81(8, 1) = 6: Sabit81(8, 2) = 7: Sabit81(8, 3) = 8: Sabit81(8, 4) = 9: Sabit81(8, 5) = 1: Sabit81(8, 6) = 2: Sabit81(8, 7) = 3: Sabit81(8, 8) = 4: Sabit81(8, 9) = 5
Sabit81(9, 1) = 9: Sabit81(9, 2) = 1: Sabit81(9, 3) = 2: Sabit81(9, 4) = 3: Sabit81(9, 5) = 4: Sabit81(9, 6) = 5: Sabit81(9, 7) = 6: Sabit81(9, 8) = 7: Sabit81(9, 9) = 8
Private Sub Sabit324Düzenle()
On Error Resume Next
Sabit324(1, 1) = 1: Sabit324(1, 2) = 2: Sabit324(1, 3) = 4: Sabit324(1, 4) = 3: Sabit324(1, 5) = 6: Sabit324(1, 6) = 5: Sabit324(1, 7) = 8: Sabit324(1, 8) = 7: Sabit324(1, 9) = 9
Sabit324(2, 1) = 3: Sabit324(2, 2) = 6: Sabit324(2, 3) = 5: Sabit324(2, 4) = 8: Sabit324(2, 5) = 7: Sabit324(2, 6) = 9: Sabit324(2, 7) = 1: Sabit324(2, 8) = 2: Sabit324(2, 9) = 4
Sabit324(3, 1) = 8: Sabit324(3, 2) = 7: Sabit324(3, 3) = 9: Sabit324(3, 4) = 1: Sabit324(3, 5) = 2: Sabit324(3, 6) = 4: Sabit324(3, 7) = 3: Sabit324(3, 8) = 6: Sabit324(3, 9) = 5
Sabit324(4, 1) = 2: Sabit324(4, 2) = 4: Sabit324(4, 3) = 3: Sabit324(4, 4) = 6: Sabit324(4, 5) = 5: Sabit324(4, 6) = 8: Sabit324(4, 7) = 7: Sabit324(4, 8) = 9: Sabit324(4, 9) = 1
Sabit324(5, 1) = 6: Sabit324(5, 2) = 5: Sabit324(5, 3) = 8: Sabit324(5, 4) = 7: Sabit324(5, 5) = 9: Sabit324(5, 6) = 1: Sabit324(5, 7) = 2: Sabit324(5, 8) = 4: Sabit324(5, 9) = 3
Sabit324(6, 1) = 7: Sabit324(6, 2) = 9: Sabit324(6, 3) = 1: Sabit324(6, 4) = 2: Sabit324(6, 5) = 4: Sabit324(6, 6) = 3: Sabit324(6, 7) = 6: Sabit324(6, 8) = 5: Sabit324(6, 9) = 8
Sabit324(7, 1) = 4: Sabit324(7, 2) = 3: Sabit324(7, 3) = 6: Sabit324(7, 4) = 5: Sabit324(7, 5) = 8: Sabit324(7, 6) = 7: Sabit324(7, 7) = 9: Sabit324(7, 8) = 1: Sabit324(7, 9) = 2
Sabit324(8, 1) = 5: Sabit324(8, 2) = 8: Sabit324(8, 3) = 7: Sabit324(8, 4) = 9: Sabit324(8, 5) = 1: Sabit324(8, 6) = 2: Sabit324(8, 7) = 4: Sabit324(8, 8) = 3: Sabit324(8, 9) = 6
Sabit324(9, 1) = 9: Sabit324(9, 2) = 1: Sabit324(9, 3) = 2: Sabit324(9, 4) = 4: Sabit324(9, 5) = 3: Sabit324(9, 6) = 6: Sabit324(9, 7) = 5: Sabit324(9, 8) = 8: Sabit324(9, 9) = 7
Sabit324(10, 1) = 1: Sabit324(10, 2) = 2: Sabit324(10, 3) = 3: Sabit324(10, 4) = 7: Sabit324(10, 5) = 8: Sabit324(10, 6) = 9: Sabit324(10, 7) = 4: Sabit324(10, 8) = 5: Sabit324(10, 9) = 6
Sabit324(11, 1) = 4: Sabit324(11, 2) = 5: Sabit324(11, 3) = 6: Sabit324(11, 4) = 1: Sabit324(11, 5) = 2: Sabit324(11, 6) = 3: Sabit324(11, 7) = 7: Sabit324(11, 8) = 8: Sabit324(11, 9) = 9
Sabit324(12, 1) = 7: Sabit324(12, 2) = 8: Sabit324(12, 3) = 9: Sabit324(12, 4) = 4: Sabit324(12, 5) = 5: Sabit324(12, 6) = 6: Sabit324(12, 7) = 1: Sabit324(12, 8) = 2: Sabit324(12, 9) = 3
Sabit324(13, 1) = 2: Sabit324(13, 2) = 3: Sabit324(13, 3) = 7: Sabit324(13, 4) = 8: Sabit324(13, 5) = 9: Sabit324(13, 6) = 4: Sabit324(13, 7) = 5: Sabit324(13, 8) = 6: Sabit324(13, 9) = 1
Sabit324(14, 1) = 5: Sabit324(14, 2) = 6: Sabit324(14, 3) = 1: Sabit324(14, 4) = 2: Sabit324(14, 5) = 3: Sabit324(14, 6) = 7: Sabit324(14, 7) = 8: Sabit324(14, 8) = 9: Sabit324(14, 9) = 4
Sabit324(15, 1) = 8: Sabit324(15, 2) = 9: Sabit324(15, 3) = 4: Sabit324(15, 4) = 5: Sabit324(15, 5) = 6: Sabit324(15, 6) = 1: Sabit324(15, 7) = 2: Sabit324(15, 8) = 3: Sabit324(15, 9) = 7
Sabit324(16, 1) = 3: Sabit324(16, 2) = 7: Sabit324(16, 3) = 8: Sabit324(16, 4) = 9: Sabit324(16, 5) = 4: Sabit324(16, 6) = 5: Sabit324(16, 7) = 6: Sabit324(16, 8) = 1: Sabit324(16, 9) = 2
Sabit324(17, 1) = 6: Sabit324(17, 2) = 1: Sabit324(17, 3) = 2: Sabit324(17, 4) = 3: Sabit324(17, 5) = 7: Sabit324(17, 6) = 8: Sabit324(17, 7) = 9: Sabit324(17, 8) = 4: Sabit324(17, 9) = 5
Sabit324(18, 1) = 9: Sabit324(18, 2) = 4: Sabit324(18, 3) = 5: Sabit324(18, 4) = 6: Sabit324(18, 5) = 1: Sabit324(18, 6) = 2: Sabit324(18, 7) = 3: Sabit324(18, 8) = 7: Sabit324(18, 9) = 8
Sabit324(19, 1) = 9: Sabit324(19, 2) = 4: Sabit324(19, 3) = 8: Sabit324(19, 4) = 2: Sabit324(19, 5) = 7: Sabit324(19, 6) = 3: Sabit324(19, 7) = 6: Sabit324(19, 8) = 1: Sabit324(19, 9) = 5
Sabit324(20, 1) = 2: Sabit324(20, 2) = 7: Sabit324(20, 3) = 3: Sabit324(20, 4) = 6: Sabit324(20, 5) = 1: Sabit324(20, 6) = 5: Sabit324(20, 7) = 9: Sabit324(20, 8) = 4: Sabit324(20, 9) = 8
Sabit324(21, 1) = 6: Sabit324(21, 2) = 1: Sabit324(21, 3) = 5: Sabit324(21, 4) = 9: Sabit324(21, 5) = 4: Sabit324(21, 6) = 8: Sabit324(21, 7) = 2: Sabit324(21, 8) = 7: Sabit324(21, 9) = 3
Sabit324(22, 1) = 8: Sabit324(22, 2) = 2: Sabit324(22, 3) = 7: Sabit324(22, 4) = 3: Sabit324(22, 5) = 6: Sabit324(22, 6) = 1: Sabit324(22, 7) = 5: Sabit324(22, 8) = 9: Sabit324(22, 9) = 4
Sabit324(23, 1) = 3: Sabit324(23, 2) = 6: Sabit324(23, 3) = 1: Sabit324(23, 4) = 5: Sabit324(23, 5) = 9: Sabit324(23, 6) = 4: Sabit324(23, 7) = 8: Sabit324(23, 8) = 2: Sabit324(23, 9) = 7
Sabit324(24, 1) = 5: Sabit324(24, 2) = 9: Sabit324(24, 3) = 4: Sabit324(24, 4) = 8: Sabit324(24, 5) = 2: Sabit324(24, 6) = 7: Sabit324(24, 7) = 3: Sabit324(24, 8) = 6: Sabit324(24, 9) = 1
Sabit324(25, 1) = 7: Sabit324(25, 2) = 3: Sabit324(25, 3) = 6: Sabit324(25, 4) = 1: Sabit324(25, 5) = 5: Sabit324(25, 6) = 9: Sabit324(25, 7) = 4: Sabit324(25, 8) = 8: Sabit324(25, 9) = 2
Sabit324(26, 1) = 1: Sabit324(26, 2) = 5: Sabit324(26, 3) = 9: Sabit324(26, 4) = 4: Sabit324(26, 5) = 8: Sabit324(26, 6) = 2: Sabit324(26, 7) = 7: Sabit324(26, 8) = 3: Sabit324(26, 9) = 6
Sabit324(27, 1) = 4: Sabit324(27, 2) = 8: Sabit324(27, 3) = 2: Sabit324(27, 4) = 7: Sabit324(27, 5) = 3: Sabit324(27, 6) = 6: Sabit324(27, 7) = 1: Sabit324(27, 8) = 5: Sabit324(27, 9) = 9
Sabit324(28, 1) = 7: Sabit324(28, 2) = 9: Sabit324(28, 3) = 1: Sabit324(28, 4) = 4: Sabit324(28, 5) = 3: Sabit324(28, 6) = 2: Sabit324(28, 7) = 6: Sabit324(28, 8) = 5: Sabit324(28, 9) = 8
Sabit324(29, 1) = 2: Sabit324(29, 2) = 4: Sabit324(29, 3) = 3: Sabit324(29, 4) = 5: Sabit324(29, 5) = 8: Sabit324(29, 6) = 6: Sabit324(29, 7) = 7: Sabit324(29, 8) = 9: Sabit324(29, 9) = 1
Sabit324(30, 1) = 6: Sabit324(30, 2) = 5: Sabit324(30, 3) = 8: Sabit324(30, 4) = 9: Sabit324(30, 5) = 1: Sabit324(30, 6) = 7: Sabit324(30, 7) = 2: Sabit324(30, 8) = 4: Sabit324(30, 9) = 3
Sabit324(31, 1) = 9: Sabit324(31, 2) = 1: Sabit324(31, 3) = 2: Sabit324(31, 4) = 3: Sabit324(31, 5) = 6: Sabit324(31, 6) = 4: Sabit324(31, 7) = 5: Sabit324(31, 8) = 8: Sabit324(31, 9) = 7
Sabit324(32, 1) = 4: Sabit324(32, 2) = 3: Sabit324(32, 3) = 6: Sabit324(32, 4) = 8: Sabit324(32, 5) = 7: Sabit324(32, 6) = 5: Sabit324(32, 7) = 9: Sabit324(32, 8) = 1: Sabit324(32, 9) = 2
Sabit324(33, 1) = 5: Sabit324(33, 2) = 8: Sabit324(33, 3) = 7: Sabit324(33, 4) = 1: Sabit324(33, 5) = 2: Sabit324(33, 6) = 9: Sabit324(33, 7) = 4: Sabit324(33, 8) = 3: Sabit324(33, 9) = 6
Sabit324(34, 1) = 1: Sabit324(34, 2) = 2: Sabit324(34, 3) = 4: Sabit324(34, 4) = 6: Sabit324(34, 5) = 5: Sabit324(34, 6) = 3: Sabit324(34, 7) = 8: Sabit324(34, 8) = 7: Sabit324(34, 9) = 9
Sabit324(35, 1) = 3: Sabit324(35, 2) = 6: Sabit324(35, 3) = 5: Sabit324(35, 4) = 7: Sabit324(35, 5) = 9: Sabit324(35, 6) = 8: Sabit324(35, 7) = 1: Sabit324(35, 8) = 2: Sabit324(35, 9) = 4
Sabit324(36, 1) = 8: Sabit324(36, 2) = 7: Sabit324(36, 3) = 9: Sabit324(36, 4) = 2: Sabit324(36, 5) = 4: Sabit324(36, 6) = 1: Sabit324(36, 7) = 3: Sabit324(36, 8) = 6: Sabit324(36, 9) = 5
Private Sub Rastgele1Düzenle()
On Error Resume Next
Rastgele1(1, 1) = VBA.Int(VBA.Rnd() * 36) + 1
Private Sub Rastgele81Düzenle()
On Error Resume Next
For i = 1 To 9
For ii = 1 To 9
Rastgele81(i, ii) = VBA.Int(VBA.Rnd() * 9) + 1
Next ii
Next i
End SubPrivate Sub Sabit324SeçimiDüzenle()
On Error Resume Next
For i = 1 To 9
Sabit324Seçimi(1, i) = i
Sabit324Seçimi(2, i) = Sabit324(Rastgele1(1, 1), i)
Next i
End SubPrivate Sub Tablo1Düzenle()
On Error Resume Next
For i = 1 To 9
For ii = 1 To 9
If Sabit81(i, ii) = 1 Then Tablo1(i, ii) = Sabit324Seçimi(2, 1)
If Sabit81(i, ii) = 2 Then Tablo1(i, ii) = Sabit324Seçimi(2, 2)
If Sabit81(i, ii) = 3 Then Tablo1(i, ii) = Sabit324Seçimi(2, 3)
If Sabit81(i, ii) = 4 Then Tablo1(i, ii) = Sabit324Seçimi(2, 4)
If Sabit81(i, ii) = 5 Then Tablo1(i, ii) = Sabit324Seçimi(2, 5)
If Sabit81(i, ii) = 6 Then Tablo1(i, ii) = Sabit324Seçimi(2, 6)
If Sabit81(i, ii) = 7 Then Tablo1(i, ii) = Sabit324Seçimi(2, 7)
If Sabit81(i, ii) = 8 Then Tablo1(i, ii) = Sabit324Seçimi(2, 8)
If Sabit81(i, ii) = 9 Then Tablo1(i, ii) = Sabit324Seçimi(2, 9)
Next ii
Next i
End SubPrivate Sub RastgeleC147Düzenle()
On Error Resume Next
RastgeleC1(1, 1) = VBA.Int(VBA.Rnd() * 3)
RastgeleC4(1, 1) = VBA.Int(VBA.Rnd() * 3)
RastgeleC7(1, 1) = VBA.Int(VBA.Rnd() * 3)
Private Sub Tablo2Düzenle()
On Error Resume Next
For i = 1 To 9
If RastgeleC1(1, 1) = 0 Then Tablo2(i, 1) = Tablo1(i, 1): Tablo2(i, 2) = Tablo1(i, 2): Tablo2(i, 3) = Tablo1(i, 3)
If RastgeleC1(1, 1) = 1 Then Tablo2(i, 1) = Tablo1(i, 2): Tablo2(i, 2) = Tablo1(i, 3): Tablo2(i, 3) = Tablo1(i, 1)
If RastgeleC1(1, 1) = 2 Then Tablo2(i, 1) = Tablo1(i, 3): Tablo2(i, 2) = Tablo1(i, 1): Tablo2(i, 3) = Tablo1(i, 2)
If RastgeleC4(1, 1) = 0 Then Tablo2(i, 4) = Tablo1(i, 4): Tablo2(i, 5) = Tablo1(i, 5): Tablo2(i, 6) = Tablo1(i, 6)
If RastgeleC4(1, 1) = 1 Then Tablo2(i, 4) = Tablo1(i, 5): Tablo2(i, 5) = Tablo1(i, 6): Tablo2(i, 6) = Tablo1(i, 4)
If RastgeleC4(1, 1) = 2 Then Tablo2(i, 4) = Tablo1(i, 6): Tablo2(i, 5) = Tablo1(i, 4): Tablo2(i, 6) = Tablo1(i, 5)
If RastgeleC7(1, 1) = 0 Then Tablo2(i, 7) = Tablo1(i, 7): Tablo2(i, 8) = Tablo1(i, 8): Tablo2(i, 9) = Tablo1(i, 9)
If RastgeleC7(1, 1) = 1 Then Tablo2(i, 7) = Tablo1(i, 8): Tablo2(i, 8) = Tablo1(i, 9): Tablo2(i, 9) = Tablo1(i, 7)
If RastgeleC7(1, 1) = 2 Then Tablo2(i, 7) = Tablo1(i, 9): Tablo2(i, 8) = Tablo1(i, 7): Tablo2(i, 9) = Tablo1(i, 8)
Next i
End SubPrivate Sub RastgeleR147Düzenle()
On Error Resume Next
RastgeleR1(1, 1) = VBA.Int(VBA.Rnd() * 3)
RastgeleR4(1, 1) = VBA.Int(VBA.Rnd() * 3)
RastgeleR7(1, 1) = VBA.Int(VBA.Rnd() * 3)
Private Sub Tablo3Düzenle()
On Error Resume Next
For i = 1 To 9
If RastgeleR1(1, 1) = 0 Then Tablo3(1, i) = Tablo2(1, i): Tablo3(2, i) = Tablo2(2, i): Tablo3(3, i) = Tablo2(3, i)
If RastgeleR1(1, 1) = 1 Then Tablo3(1, i) = Tablo2(2, i): Tablo3(2, i) = Tablo2(3, i): Tablo3(3, i) = Tablo2(1, i)
If RastgeleR1(1, 1) = 2 Then Tablo3(1, i) = Tablo2(3, i): Tablo3(2, i) = Tablo2(1, i): Tablo3(3, i) = Tablo2(2, i)
If RastgeleR4(1, 1) = 0 Then Tablo3(4, i) = Tablo2(4, i): Tablo3(5, i) = Tablo2(5, i): Tablo3(6, i) = Tablo2(6, i)
If RastgeleR4(1, 1) = 1 Then Tablo3(4, i) = Tablo2(5, i): Tablo3(5, i) = Tablo2(6, i): Tablo3(6, i) = Tablo2(4, i)
If RastgeleR4(1, 1) = 2 Then Tablo3(4, i) = Tablo2(6, i): Tablo3(5, i) = Tablo2(4, i): Tablo3(6, i) = Tablo2(5, i)
If RastgeleR7(1, 1) = 0 Then Tablo3(7, i) = Tablo2(7, i): Tablo3(8, i) = Tablo2(8, i): Tablo3(9, i) = Tablo2(9, i)
If RastgeleR7(1, 1) = 1 Then Tablo3(7, i) = Tablo2(8, i): Tablo3(8, i) = Tablo2(9, i): Tablo3(9, i) = Tablo2(7, i)
If RastgeleR7(1, 1) = 2 Then Tablo3(7, i) = Tablo2(9, i): Tablo3(8, i) = Tablo2(7, i): Tablo3(9, i) = Tablo2(8, i)
Next i
End SubSub TabloSudokuDüzenle()
On Error Resume Next
For i = 1 To 9
For ii = 1 To 9
If (ComboBox1.ListIndex + 2 >= Rastgele81(i, ii)) Then 'Zorluk Derecesi Seçimi
TabloSudoku(i, ii) = ""
Else
TabloSudoku(i, ii) = Tablo3(i, ii)
End If
Next ii
Next i
End Sub'Module1
Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'It may take a few seconds, please wait.
Public Const URL1 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg" 'Microsoft Office Excel® Kod Klavuzu [Vector Backround]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
Public Const URL3 As String = "http://4.bp.blogspot.com/_hsHTxo_5L8E/TKHXL1-dHVI/AAAAAAAAClo/xxJAhuSHReI/s1600/seven-shine-1024-768.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
Public URL As String
Sub FormAç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
'Sub References_List()
' On Error Resume Next
' Dim Eleman, No
' No = 1
' For Each Eleman In ThisWorkbook.VBProject.References
' Sheets(1).Cells(No, 1) = No & ") Name: "
' Sheets(1).Cells(No, 2) = Eleman.Name
' Sheets(1).Cells(No, 3) = ", Description: "
' Sheets(1).Cells(No, 4) = Eleman.Description
' Sheets(1).Cells(No, 5) = ", FullPath: "
' Sheets(1).Cells(No, 6) = Eleman.FullPath
' No = No + 1
' Next Eleman
'End Sub
0 yorum:
Yorum Gönder