Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ekim 2010 Pazar

Web TV & Radio



'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: WMPLib, Description: Windows Media Player, FullPath: C:\WINDOWS\system32\wmp.dll [Picture: 1]

'B) UserForm1 E Eklenen Araçlar (Add Tools)

'B1) Image1, Label1, Label2
'B2) WindowsMediaPlayer1
'B3) Label3,ComboBox1,Label5
'B4) Label4,ComboBox2,Label6

Option Explicit
Dim No As Double
Private Sub UserForm_Initialize()

On Error Resume Next
Dim i As Integer
Call Ekran_Düzenle
Call TV_Listele
Call Radyo_Listele
Me.Caption = "[PBİD®] Web TV & Radio"

End Sub
Private Sub ComboBox1_Click()

On Error Resume Next
No = ComboBox1.ListIndex
ComboBox2.ListIndex = -1
Label6.Caption = ""
WindowsMediaPlayer1.URL = ComboBox1.List(No, 1)
Label5.Caption = " " & ComboBox1.List(ComboBox1.ListIndex, 1)

End Sub
Private Sub ComboBox2_Click()

On Error Resume Next
No = ComboBox2.ListIndex
ComboBox1.ListIndex = -1
Label5.Caption = ""
WindowsMediaPlayer1.URL = ComboBox2.List(No, 1)
Label6.Caption = " " & ComboBox2.List(ComboBox2.ListIndex, 1)

End Sub
Sub Ekran_Düzenle()

On Error Resume Next
With Me

.Width = 420
.Height = 418
.BackColor = vbWhite
.Picture = Resim(URL1)
'.Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
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 WindowsMediaPlayer1

.Left = 6
.Top = 36
.Height = 306
.Width = 402

End With
With Label3

.BackStyle = fmBackStyleTransparent
.Caption = " TV"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 348
.Height = 18
.Width = 42
.ForeColor = &H808000
.Font.Bold = True

End With
With ComboBox1

.Left = 48
.Top = 348
.Height = 18
.Width = 102
.SpecialEffect = fmSpecialEffectEtched
.BackColor = vbBlack
.ForeColor = &HFF00& '&H808000
.Font.Bold = False
.ColumnCount = 2
.ColumnWidths = "240;42"

End With
With Label5

.BackStyle = fmBackStyleTransparent
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.Left = 150
.Top = 348
.Height = 18
.Width = 258
.ForeColor = &H808000
.Font.Bold = True

End With
With Label4

.BackStyle = fmBackStyleTransparent
.Caption = " Radyo"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 366
.Height = 18
.Width = 42
.ForeColor = &H808000
.Font.Bold = True

End With
With ComboBox2

.Left = 48
.Top = 366
.Height = 18
.Width = 102
.SpecialEffect = fmSpecialEffectEtched
.BackColor = vbBlack
.ForeColor = &HFF00& '&H808000
.Font.Bold = False
.ColumnCount = 2
.ColumnWidths = "240;42"

End With
With Label6

.BackStyle = fmBackStyleTransparent
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.Left = 150
.Top = 366
.Height = 18
.Width = 258
.ForeColor = &H808000
.Font.Bold = True

End With

End With

End Sub
Sub TV_Listele()

On Error Resume Next
ComboBox1.AddItem "TRT 1": ComboBox1.List(0, 1) = "mms://95.0.159.131/TV1"
ComboBox1.AddItem "TRT 2 Haber": ComboBox1.List(1, 1) = "mms://95.0.159.131/TV2"
ComboBox1.AddItem "TRT 3": ComboBox1.List(2, 1) = "mms://95.0.159.131/TV3"
ComboBox1.AddItem "TRT4 Çocuk": ComboBox1.List(3, 1) = "mms://95.0.159.131/TV4"
ComboBox1.AddItem "TRT 6": ComboBox1.List(4, 1) = "mms://95.0.159.131/TV6"
ComboBox1.AddItem "TRT Müzik": ComboBox1.List(5, 1) = "mms://95.0.159.131/TRTMUZIK"
ComboBox1.AddItem "TRT Türk": ComboBox1.List(6, 1) = "mms://95.0.159.131/TRTTURK"
ComboBox1.AddItem "TRT Avaz": ComboBox1.List(7, 1) = "mms://95.0.159.131/TRTAVAZ"
ComboBox1.AddItem "TRT Belgesel": ComboBox1.List(8, 1) = "mms://95.0.159.131/TRTBELGESEL"
ComboBox1.AddItem "TRT Arapça": ComboBox1.List(9, 1) = "mms://95.0.159.133/TRTARABIC"
ComboBox1.AddItem "TRT International": ComboBox1.List(10, 1) = "mms://212.175.166.3/TRTINT"
ComboBox1.AddItem "Cine 5": ComboBox1.List(11, 1) = "mms://yayin.cine5.com.tr/cine5"
ComboBox1.AddItem "NTV": ComboBox1.List(12, 1) = "mms://144.122.56.15/odtutv"
ComboBox1.AddItem "Samanyolu": ComboBox1.List(13, 1) = "mms://canli.samanyolu.tv/stv"
ComboBox1.AddItem "Samanyolu TV Haber": ComboBox1.List(14, 1) = "mms://canli.samanyoluhaber.tv/shaber"
ComboBox1.AddItem "Expo Channel": ComboBox1.List(15, 1) = "mms://yayin.canlitv.com/expochannel"
ComboBox1.AddItem "Güney TV": ComboBox1.List(16, 1) = "mms://yayin.canlitv.com/guneytv/guneytv.asf"
ComboBox1.AddItem "Olay TV": ComboBox1.List(17, 1) = "mms://yayin.canlitv.com/olaytv"
ComboBox1.AddItem "TV 41": ComboBox1.List(18, 1) = "mms://yayin.canlitv.com/tv41"
ComboBox1.AddItem "Yol TV": ComboBox1.List(19, 1) = "mms://85.214.55.224/yol"
ComboBox1.AddItem "Kanal B ": ComboBox1.List(20, 1) = "mms://193.140.161.79/kanalb "
ComboBox1.AddItem "Yumurcak TV": ComboBox1.List(21, 1) = "mms://canli.yumurcak.tv/yumurcak"
ComboBox1.AddItem "BRT1 TV": ComboBox1.List(22, 1) = "mms://bms.brtk.net/brttv"
ComboBox1.AddItem "BRT2 TV": ComboBox1.List(23, 1) = "mms://bms.brtk.net/brt2"
ComboBox1.AddItem "DRT TV": ComboBox1.List(24, 1) = "mms://euro3.bizidinle.com/yayin-bd-drttv"
ComboBox1.AddItem "Kıbrıs Genç": ComboBox1.List(25, 1) = "mms://euro3.bizidinle.com/yayin-bd-kibrisgenctv"
ComboBox1.AddItem "TV 5": ComboBox1.List(26, 1) = "mms://94.75.240.130/tv5"
ComboBox1.AddItem "Amasya Art TV": ComboBox1.List(27, 1) = "mms://euro3.bizidinle.com/yayin-bd-arttv"
ComboBox1.AddItem "Günaz TV": ComboBox1.List(28, 1) = "mms://v1.webcasting.com/webcasting_gunaz"
ComboBox1.AddItem "Hilal TV": ComboBox1.List(29, 1) = "mms://94.75.240.130/hilaltv"
ComboBox1.AddItem "Hizmet TV": ComboBox1.List(30, 1) = "mms://euro3.bizidinle.com/yayin-bd-hizmettv"
ComboBox1.AddItem "Kaçkar TV": ComboBox1.List(31, 1) = "mms://94.75.240.130/kackartv"
ComboBox1.AddItem "Kanal 51": ComboBox1.List(32, 1) = "mms://94.75.240.158/kanal51"
ComboBox1.AddItem "Kanal Alanya": ComboBox1.List(33, 1) = "mms://kanalalanya.com/kanalalanya"
ComboBox1.AddItem "Kanal Vip VTV": ComboBox1.List(34, 1) = "mms://88.225.223.212/"
ComboBox1.AddItem "Mehtap TV": ComboBox1.List(35, 1) = "mms://canli.mehtap.tv/mehtap"
ComboBox1.AddItem "Ada TV": ComboBox1.List(36, 1) = "mms://212.175.149.82:8080"
ComboBox1.AddItem "Kanal 3 TV": ComboBox1.List(37, 1) = "mms://91.191.163.159/Kanal3tv"
ComboBox1.AddItem "Kanal 67": ComboBox1.List(38, 1) = "mms://94.75.240.130/emrah"
ComboBox1.AddItem "Kanal 48": ComboBox1.List(39, 1) = "mms://yayin.canlitv.com/kanal48"
ComboBox1.AddItem "Kırşehir TV": ComboBox1.List(40, 1) = "mms://94.75.240.129/kirsehirtv"
ComboBox1.AddItem "Fenerbaçe Tv ": ComboBox1.List(41, 1) = "mms://media01.ad1.softcom.biz/fbtv-173?TID=d360875c"
ComboBox1.AddItem "Adım TV": ComboBox1.List(42, 1) = "mms://66.90.118.66/adimtv"
ComboBox1.AddItem "ATV": ComboBox1.List(43, 1) = "mms://213.74.13.115/atv"
ComboBox1.AddItem "Channel 125": ComboBox1.List(44, 1) = "mms://channel125.com/channel125"
ComboBox1.AddItem "Delux Music TV": ComboBox1.List(45, 1) = "mms://mp-mmsc-2.mpservers.net/deluxemusictv_10"
ComboBox1.AddItem "Dost TV": ComboBox1.List(46, 1) = "mms://dosttv.propagation.net/DostTV"
ComboBox1.AddItem "Gelişim": ComboBox1.List(47, 1) = "mms://81.214.70.75:8090"
ComboBox1.AddItem "Giga": ComboBox1.List(48, 1) = "http://broadcast.giga.de:80"
ComboBox1.AddItem "JCTV": ComboBox1.List(49, 1) = "mms://us-eu-st13g1.att-idns.net/3408_4365_04.asf"
ComboBox1.AddItem "K7": ComboBox1.List(50, 1) = "http://yayin.yayindayiz.biz:8110"
ComboBox1.AddItem "Kral TV": ComboBox1.List(51, 1) = "mms://217.31.235.46/kraltv"
ComboBox1.AddItem "Number One": ComboBox1.List(52, 1) = "mms://66.90.101.68/TV-NumberOne "
ComboBox1.AddItem "ODTÜ TV": ComboBox1.List(53, 1) = "mms://144.122.56.15/ODTU-TV"
ComboBox1.AddItem "Ontop TV": ComboBox1.List(54, 1) = "mms://64.71.165.133/ontoptv"
ComboBox1.AddItem "Show TV": ComboBox1.List(55, 1) = "mms://95.211.98.3/TV-ShowTv"
ComboBox1.AddItem "Sky TV": ComboBox1.List(56, 1) = "mms://213.74.22.66/skyturk"
ComboBox1.AddItem "Soul Beat TV": ComboBox1.List(57, 1) = "http://vista.streamguys.com/soulbeattv"
ComboBox1.AddItem "Star TV": ComboBox1.List(58, 1) = "mms://217.31.235.46/startv "
ComboBox1.AddItem "STV": ComboBox1.List(59, 1) = "mms://usa.stv.com.tr/live"
ComboBox1.AddItem "TGRT": ComboBox1.List(60, 1) = "http://70.84.33.194:8140/"
ComboBox1.AddItem "WAM TV": ComboBox1.List(61, 1) = "mms://146.101.200.150/WAMTV"
ComboBox1.AddItem "Türkmeneli TV": ComboBox1.List(62, 1) = "mms://66.90.101.25/turkmen"
ComboBox1.AddItem "Hilal TV": ComboBox1.List(63, 1) = "mms://94.75.240.130/hilaltv "
ComboBox1.AddItem "MPL TV": ComboBox1.List(64, 1) = "mms://mpl.dyndns.tv/MPL "
ComboBox1.AddItem "Expochannel": ComboBox1.List(65, 1) = "mms://yayin.canlitv.com/expochannel"
ComboBox1.AddItem "TV 24": ComboBox1.List(66, 1) = "mms://91.93.103.51/24live "
ComboBox1.AddItem "Kanal A": ComboBox1.List(67, 1) = "mms://88.255.31.105:554/kanala1"

End Sub
Sub Radyo_Listele()

On Error Resume Next
ComboBox2.AddItem "TRT Radyo 1": ComboBox2.List(0, 1) = "mms://95.0.159.130/RADYO1"
ComboBox2.AddItem "TRT Radyo 3": ComboBox2.List(1, 1) = "mms://95.0.159.130/RADYO3"
ComboBox2.AddItem "TRT Radyo 4": ComboBox2.List(2, 1) = "mms://95.0.159.130/RADYO4"
ComboBox2.AddItem "TRT FM": ComboBox2.List(3, 1) = "mms://95.0.159.130/RADYOFM"
ComboBox2.AddItem "TRT Türk": ComboBox2.List(4, 1) = "mms://95.0.159.130/TURKU"
ComboBox2.AddItem "TRT TSR": ComboBox2.List(5, 1) = "mms://95.0.159.130/RDTSR"
ComboBox2.AddItem "TRT Vot East": ComboBox2.List(6, 1) = "mms://95.0.159.130/RDVOT2"
ComboBox2.AddItem "TRT Vot World": ComboBox2.List(7, 1) = "mms://95.0.159.130/RDVOT"
ComboBox2.AddItem "TRT Vot West": ComboBox2.List(8, 1) = "mms://95.0.159.130/RDTSR2"
ComboBox2.AddItem "TRT Radyo 6": ComboBox2.List(9, 1) = "mms://95.0.159.130/RADWORLD2"
ComboBox2.AddItem "TRT Nağme": ComboBox2.List(10, 1) = "mms://95.0.159.130/TSM"
ComboBox2.AddItem "TRT Ankara": ComboBox2.List(11, 1) = "mms://95.0.159.130/KENT"
ComboBox2.AddItem "TRT Avrupa": ComboBox2.List(12, 1) = "mms://95.0.159.130/AVRUPA"
ComboBox2.AddItem "TRT Antalya": ComboBox2.List(13, 1) = "mms://95.0.159.130/ANTALYA"
ComboBox2.AddItem "TRT GAP": ComboBox2.List(14, 1) = "mms://95.0.159.130/TRTGAP"
ComboBox2.AddItem "TRT Erzurum": ComboBox2.List(15, 1) = "mms://95.0.159.130/ERZURUM"
ComboBox2.AddItem "TRT Çukurova": ComboBox2.List(16, 1) = "mms://95.0.159.130/CUKUROVA"
ComboBox2.AddItem "TRT Trabzon": ComboBox2.List(17, 1) = "mms://95.0.159.130/TRABZON"
ComboBox2.AddItem "Radyo D": ComboBox2.List(18, 1) = "mms://84.16.230.44/Radyod"
ComboBox2.AddItem "Bayrak Radyosu": ComboBox2.List(19, 1) = "mms://bms.brtk.net/bayrakradio"
ComboBox2.AddItem "Bayrak Internatiıonal": ComboBox2.List(20, 1) = "mms://bms.brtk.net/bayrak-int"
ComboBox2.AddItem "Bayrak FM": ComboBox2.List(21, 1) = "mms://bms.brtk.net/bayrakfm"
ComboBox2.AddItem "Radyo Akdeniz": ComboBox2.List(22, 1) = "mms://ns9.adabilisim.net/radyoakdeniz"
ComboBox2.AddItem "Gözyaşı FM": ComboBox2.List(23, 1) = "mms://94.75.240.129/gozyasi1"
ComboBox2.AddItem "Sakarya Hür FM": ComboBox2.List(24, 1) = "http://sunucu2.radyolarburada.com:8165"
ComboBox2.AddItem "Moral FM": ComboBox2.List(25, 1) = "mms://94.75.240.130/moralfm"
ComboBox2.AddItem "İzmir Sahil FM": ComboBox2.List(26, 1) = "mms://89.19.26.210/radyosahil"
ComboBox2.AddItem "Slow Türk": ComboBox2.List(27, 1) = "mms://84.16.227.54/slowturk"
ComboBox2.AddItem "Power Türk": ComboBox2.List(28, 1) = "mms://xiphias.vargonen.net/PowerTurk"
ComboBox2.AddItem "Power FM": ComboBox2.List(29, 1) = "mms://xiphias.vargonen.net/PowerFm"
ComboBox2.AddItem "Swow Radyo": ComboBox2.List(30, 1) = "mms://84.16.235.90/ShowRadyo"
ComboBox2.AddItem "Best FM": ComboBox2.List(31, 1) = "mms://195.175.9.14/rd-bestfm"
ComboBox2.AddItem "Alem FM": ComboBox2.List(32, 1) = "mms://195.175.9.14/rd-alemfm"
ComboBox2.AddItem "Number One FM": ComboBox2.List(33, 1) = "mms://195.175.9.14/rd-numberonefm"
ComboBox2.AddItem "Radyo Viva": ComboBox2.List(34, 1) = "mms://84.16.235.95/rv"
ComboBox2.AddItem "Açık Radyo": ComboBox2.List(35, 1) = "mms://195.175.9.14/rd-acikradyo"
ComboBox2.AddItem "Radyo Mydonose Türk": ComboBox2.List(36, 1) = "mms://195.175.9.14/rd-radyomydonoseturk"

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 URL As String
Sub FormAç() 'Open UserForm

On Error Resume Next
UserForm1.Show 0

End Sub
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

End Function
'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

7 Ekim 2010 Perşembe

SuperLoto Randomize (Estimate) Tool



'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 [Picture:1]

'B) UserForm1 E Eklenen Araçlar (Add Tools)

'B1) Image1, Label1, Label2
'B2) Label3,TextBox1,Label4,TextBox2,Label5,TextBox3
'B3) ListBox1
'B4) CommandButton1

Option Explicit
Dim KolonAdet As Integer, TopAdet As Integer, SatırAdet As Integer
Dim Sayaç(1 To 3)
Dim Birim As Boolean
Dim i As Integer, ii As Integer, iii As Integer, iv As Integer, Numara As Integer
Dim Arşiv As Variant
Dim Sonuç
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] SuperLoto Randomize (Estimate) Tool"
Call EkranDüzenle

End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 228.75
.Width = 269.25
.BackColor = vbWhite
.Picture = Resim(URL1)
'.Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
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 Label3

.Caption = " " & "Kolon Sayısı"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 36
.Height = 18
.Width = 54
.ForeColor = &H80000012

End With
With TextBox1

.Value = 6
.SpecialEffect = fmSpecialEffectEtched
.Left = Label3.Left + Label3.Width
.Top = 36
.Height = 18
.Width = 30
.ForeColor = vbBlue

End With
With Label4

.Caption = " " & "Top Sayısı"
.SpecialEffect = fmSpecialEffectEtched
.Left = TextBox1.Left + TextBox1.Width
.Top = 36
.Height = 18
.Width = 54
.ForeColor = &H80000012

End With
With TextBox2

.Value = 49
.SpecialEffect = fmSpecialEffectEtched
.Left = Label4.Left + Label4.Width
.Top = 36
.Height = 18
.Width = 30
.ForeColor = vbBlue

End With
With Label5

.Caption = " " & "Satır Sayısı"
.SpecialEffect = fmSpecialEffectEtched
.Left = TextBox2.Left + TextBox2.Width
.Top = 36
.Height = 18
.Width = 54
.ForeColor = &H80000012

End With
With TextBox3

.Value = 12
.SpecialEffect = fmSpecialEffectEtched
.Left = Label5.Left + Label5.Width
.Top = 36
.Height = 18
.Width = 30
.ForeColor = vbBlue

End With
With ListBox1

.ColumnCount = TextBox1.Value
.ColumnWidths = "40;40;40;40;40;40"
.SpecialEffect = fmSpecialEffectEtched
.BackColor = &H80000018
.Left = 6
.Top = 54
.Height = 123.75
.Width = TextBox1.Value * 40 + 12

End With
With CommandButton1

.Caption = "Oyna"
.Left = 6
.Top = 180
.Height = 18
.Width = 252

End With

End With

End Sub
Private Sub CommandButton1_Click()

On Error GoTo Hata
KolonAdet = TextBox1.Value
TopAdet = TextBox2.Value
SatırAdet = TextBox3.Value
ReDim OyunHafıza(1 To SatırAdet, 1 To KolonAdet)
ii = 1
ListBox1.Clear
For i = 1 To SatırAdet

Call SüperLoto
For Sayaç(1) = 1 To KolonAdet

For ii = 1 To KolonAdet

OyunHafıza(i, ii) = Sonuç(ii)

Next ii

Next Sayaç(1)

Next i
ListBox1.List() = OyunHafıza
Call SayfaDüzenle
Exit Sub
Hata:
MsgBox Error(Err), vbExclamation, "[PBİD®] Veri Giriş Hatası..."
ListBox1.Clear

End Sub
Private Function SüperLoto()

ReDim Hafıza(KolonAdet) As Integer
VBA.Randomize
Sayaç(1) = 0
Sayaç(3) = 1
Do

Sayaç(1) = Sayaç(1) + 1
Do

Birim = False
Numara = VBA.Int(VBA.Rnd * TopAdet) + 1
For Sayaç(2) = 1 To KolonAdet

If Numara = Hafıza(Sayaç(2)) Then Birim = True: Exit For

Next Sayaç(2)
If Birim = False Then Hafıza(Sayaç(1)) = Numara

Loop Until Birim = False

Loop Until Sayaç(1) >= KolonAdet 'Kolon Sayısı Kadar
For iii = 1 To KolonAdet

For iv = 1 To KolonAdet - 1

If Hafıza(iv) > Hafıza(iii) Then 'Sırala

Arşiv = Hafıza(iv)
Hafıza(iv) = Hafıza(iii)
Hafıza(iii) = Arşiv

End If

Next iv

Next iii
Sonuç = Hafıza

End Function
Sub SayfaDüzenle()

On Error Resume Next
Cells.Delete Shift:=xlUp
ActiveSheet.Cells(1, 1) = "No"
For i = 1 To TextBox1.Value

ActiveSheet.Cells(1, 1 + i) = "Kolon" & i

Next i
With ActiveSheet.Range(Cells(1, 1), Cells(1, TextBox1.Value + 1))

.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid

End With
With ActiveSheet.Range(Cells(1, 1), Cells((TextBox1.Value * 2) + 1, 1))

.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid

End With
With ActiveSheet.Columns("A:IV")

.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit

End With
ActiveSheet.Range(Cells(2, 2), Cells(TextBox3.Value + 1, TextBox1.Value + 1)) = ListBox1.List
For i = 1 To TextBox3.Value

ActiveSheet.Cells(i + 1, 1) = i

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 URL As String
Sub FormAç() 'Open UserForm

On Error Resume Next
UserForm1.Show 0

End Sub
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

End Function
'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

4 Ekim 2010 Pazartesi

Sudoku Excel Solver | Excel Games




'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]

'B) UserForm1'e Eklenen Araçlar (Add Tools)

'B1) Image1, Label1, Label2
'B2) ComboBox1 , CommandButton1
'B3) Spreadsheet1
'B4) CommandButton2, CommandButton3, CommandButton4

Option Explicit
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

End Sub
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 Sub
Private 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 Sub
Private 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 Sub
Private Sub CommandButton4_Click()

On Error Resume Next
Me.PrintForm

End Sub
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 Sub
Private 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

End Sub
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

End Sub
Private Sub Rastgele1Düzenle()

On Error Resume Next
Rastgele1(1, 1) = VBA.Int(VBA.Rnd() * 36) + 1

End Sub
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 Sub
Private 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 Sub
Private 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 Sub
Private 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)

End Sub
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 Sub
Private 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)

End Sub
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 Sub
Sub 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

End Sub
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

End Function
'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

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul