Tembellik edip kodları değiştirmediğimden dolayı kodları aynen yayınlıyorum. Formunuza 9 adet textbox ekleyin. 8.Textbox ın ismi Adres
9.textboxı text10 diye geciyor. 14 buton,checkbox,2 adet toolbar,2 adet optionbutton ,timer,picturebox,2 adet image
2 adet imagelist,webbroser kontrolu tasarımını size bırakıyorum. Fakat bir webbrowser gibi tasarlarsanız hoş olur. oss sonuclarını indirmek icinde başka bir calışmam var. isterseniz bu calışmayı oss sınavı icinde uyarlayabilirsiniz. onuda yakın bir zamanda gonderebilirim.aday numaralarını el ile girmek biraz zahmetli oluyor. sayfanın adresinde numara sorgulaması vardır. bu sorgu değişkenine textbox ın icindeki değeri eklerseniz websayfasındaki textboxın icine yazmış gibi sorgular.WebBrowser1.Navigate Adres.Text+text4.text diye yazarsanız lgs numarasını parametre olarak websayfasına yollar. sizin aday numarasını yazmanıza gerek kalmaz. fazla uğraşmadım ilgilenen arkadaşlar bunu geliştireceklerine eminim.




'Once değişkenler
Dim MyExcel As Object
Dim MyChart As Object
Dim i
Dim db As Database
Dim rs As Recordset
Dim Baglanti
Dim rs1
Dim sql
Dim id



'check2 yi aktif yaparsanız.sonucları girerken, bir sonraki kayıta kendi gidiyor
Private Sub Check2_Click()
If Check2.Value = Checked Then
Command13.Enabled = True
rs.MoveFirst
Text1.Text = rs("dno")
Text2.Text = rs("ad")
Text3.Text = rs("soyad")
Text4.Text = rs("alno")
If IsNull(rs("kazok")) And IsNull(rs("tpuan")) And IsNull(rs("fpuan")) Then
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Else
Text5.Text = rs("kazok")
Text6.Text = rs("tpuan")
Text7.Text = rs("fpuan")
End If

Else
Command3.Enabled = False
End If

End Sub

Private Sub Command11_Click()
On Error Resume Next
rs.MovePrevious
Text1.Text = rs("dno")
Text2.Text = rs("ad")
Text3.Text = rs("soyad")
If IsNull(rs("alno")) Then
Text4.Text = ""
Else
Text4.Text = rs("alno")
End If
If IsNull(rs("alno")) Then
Text4.Text = ""
Else
Text4.Text = rs("alno")
End If
If IsNull(rs("kazok")) Then
Text5.Text = ""
Else
Text5.Text = rs("kazok")
End If
If IsNull(rs("tpuan")) Then
Text6.Text = ""
Else
Text6.Text = rs("tpuan")
End If
If IsNull(rs("fpuan")) Then
Text7.Text = ""
Else
Text7.Text = rs("fpuan")
End If
If Err Then MsgBox "son kayıt uzerindesiniz"
Text4.SetFocus
End Sub

Private Sub Command12_Click()
On Error Resume Next
rs.MoveNext
Text1.Text = rs("dno")
Text2.Text = rs("ad")
Text3.Text = rs("soyad")
If IsNull(rs("alno")) Then
Text4.Text = ""
Else
Text4.Text = rs("alno")
End If
If IsNull(rs("kazok")) Then
Text5.Text = ""
Else
Text5.Text = rs("kazok")
End If
If IsNull(rs("tpuan")) Then
Text6.Text = ""
Else
Text6.Text = rs("tpuan")
End If
If IsNull(rs("fpuan")) Then
Text7.Text = ""
Else
Text7.Text = rs("fpuan")
End If
If Err Then MsgBox "son kayıt uzerindesiniz"
Text4.SetFocus

End Sub

Private Sub Command13_Click()
On Error Resume Next
rs.Edit
rs("dno") = Text1.Text
rs("ad") = Text2.Text
rs("soyad") = Text3.Text
rs("alno") = Text4.Text
rs("kazok") = Text5.Text
rs("tpuan") = Text6.Text
rs("fpuan") = Text7.Text
rs.Update
If Check2.Value = Checked Then Command12_Click
WebBrowser1.GoBack

End Sub


'şimdi kayıtlarımızı excele aktarıyoruz. Daha kısa ve hızlı kodlar mevcut bunlarıda uygulayabilirsiniz.
Private Sub Command6_Click()
On Error Resume Next
A = MsgBox("Excel ile rapor almak istiyormusunuz", vbYesNo, "Excele Aktar")
If A = vbYes Then
Form1.MousePointer = 11
Set MyExcel = CreateObject("Excel.Application")


MyExcel.Visible = True
visible=true
MyExcel.Workbooks.Add



MyExcel.Cells(1, 1).Value = "Derhane No"
MyExcel.Cells(1, 2).Value = "Adı"
MyExcel.Cells(1, 3).Value = "Soyadı"
MyExcel.Cells(1, 4).Value = "And.L.NO"
MyExcel.Cells(1, 5).Value = "Kazandığı Okul"
MyExcel.Cells(1, 6).Value = "Top Ağ.Puan"
MyExcel.Cells(1, 7).Value = "Fen Puanı"

MyExcel.Cells(1, 1).Font.Bold = True
MyExcel.Cells(1, 2).Font.Bold = True
MyExcel.Cells(1, 3).Font.Bold = True
MyExcel.Cells(1, 4).Font.Bold = True
MyExcel.Cells(1, 5).Font.Bold = True
MyExcel.Cells(1, 6).Font.Bold = True
MyExcel.Cells(1, 7).Font.Bold = True



rs.MoveFirst
i = 2
While Not rs.EOF
MyExcel.range("A" & i).Value = rs.Fields("dno")
MyExcel.range("B" & i).Value = rs.Fields("ad")
MyExcel.range("C" & i).Value = rs.Fields("soyad")
MyExcel.range("D" & i).Value = rs.Fields("alno")
MyExcel.range("E" & i).Value = rs.Fields("kazok")
MyExcel.range("F" & i).Value = rs.Fields("tpuan")
MyExcel.range("G" & i).Value = rs.Fields("fpuan")

i = i + 1
rs.MoveNext
Wend



If Err Then
MsgBox "Tum kayıtlar aktarılmadan exceli kapattınız"
Form1.MousePointer = 0
Exit Sub
End If
End If
End Sub


Private Sub Command1_Click()

Text1.Text = ""
Text1.Enabled = True
Text1.BackColor = &HC0FFFF
Text2.Text = ""
Text2.Enabled = True
Text2.BackColor = &HC0FFFF
Text3.Text = ""
Text3.Enabled = True
Text3.BackColor = &HC0FFFF
Text4.Text = ""
Text4.Enabled = True
Text4.BackColor = &HC0FFFF

Text1.SetFocus
End Sub


Private Sub Command2_Click()
If IsNumeric(Text1.Text) = True Or Text1.Text "" Then
sql = "select dno from lgs where dno=" & Text1.Text
Set rs1 = Baglanti.Execute(sql)
If Not rs1.EOF Then
MsgBox ("Bu Numarada Kayıtlı Bir Oğrenci Var!")
Set rs1 = Nothing
GoTo 10
Else
Set rs1 = Nothing
End If
sql = "insert into lgs(dno,ad,soyad,sinif,alno,kazok,tpuan,fpuan) values(" & Text1.Text & ","' & Text2.Text & "',"' & Text3.Text & "',"' & Text4.Text & "',"' & Text5.Text & "',"' & Text6.Text & "',"' & Text7.Text & "')"
Baglanti.Execute (sql)
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""

Else
MsgBox "Dershane No Strign değer alamaz veya boş olamaz"
10 End If


End Sub

Private Sub Command3_Click()
sql = "select*from lgs where dno=" & Text1.Text & " and id " & id
Set rs1 = Baglanti.Execute(sql)
If Not rs1.EOF Then
MsgBox ("Boyle bir Oğrenci kayıtlı! Lutfen doğru numarayı girin.")
Set rs1 = Nothing
GoTo 10
Else
Set rs1 = Nothing
End If
sql = "update lgs set dno=" & Text1.Text & ",ad="' & Text2.Text & "', soyad="' & Text3.Text & "',alno= "' & Text4.Text & "', kazok= "' & Text5.Text & "',tpuan= "' & Text6.Text & "',fpuan= "' & Text7.Text & "' where id=" & id
Baglanti.Execute (sql)
10
End Sub

Private Sub Command4_Click()
sql = "delete from lgs where id=" & id
Baglanti.Execute (sql)
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""

Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text1.BackColor = &H80000005
Text2.BackColor = &H80000005
Text3.BackColor = &H80000005
Text4.BackColor = &H80000005
Text5.BackColor = &H80000005

End Sub

Private Sub Command5_Click()
Text10.Text = ""
Frame3.Visible = True
Text10.SetFocus

End Sub





Private Sub Command7_Click()
If Option1.Value = True Then command9_click
If Option2.Value = True Then command10_click

End Sub

Private Sub Command8_Click()
Frame3.Visible = False
End Sub

Private Sub Form_Load()
Dim BagStr As String
Set Baglanti = New ADODB.Connection
Baglanti.Open "Driver=; DBQ=" & App.Path & "vt1.mdb"
Set rs1 = New ADODB.Recordset
Option2.Value = True

Set db = OpenDatabase(App.Path & "vt1.mdb")
Set rs = db.OpenRecordset("lgs")
goster_Click
End Sub

Private Sub Frame1_Click()
Frame4.Visible = False
End Sub


Private Sub Frame4_Click()
Frame4.Visible = False
End Sub


Private Sub Option1_Click()
If Option1.Value = True Then
Option2.Value = False
Option2.ForeColor = &H80000012
Option1.ForeColor = &HFF0000
End If

End Sub

Private Sub Option2_Click()
If Option2.Value = True Then
Option1.Value = False
Option1.ForeColor = &H80000012
Option2.ForeColor = &HFF0000
End If

End Sub
Private Sub command9_click()
On Error Resume Next
sql = "select * from lgs where soyad = "' & Text10.Text & ""'
Set rs1 = Baglanti.Execute(sql)
Text1.Text = rs1("dno")
Text2.Text = rs1("ad")
Text3.Text = rs1("soyad")
Text4.Text = rs1("alno")
'Text5.Text = rs1("kazok")
If IsNull(rs1("kazok")) And IsNull(rs1("tpuan")) And IsNull(rs1("fpuan")) Then
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Else
Text5.Text = rs1("kazok")
Text6.Text = rs1("tpuan")
Text7.Text = rs1("fpuan")
End If
id = rs1("id")

If Err Then
MsgBox "aradığınız kayıt bulunamadı"
GoTo 10
End If
Command3.Enabled = True
Command4.Enabled = True
Text1.Enabled = True
Text1.BackColor = &HC0FFFF
Text2.Enabled = True
Text2.BackColor = &HC0FFFF
Text3.Enabled = True
Text3.BackColor = &HC0FFFF
Text4.Enabled = True
Text4.BackColor = &HC0FFFF
Text5.Enabled = True
Text5.BackColor = &HC0FFFF
Text1.SetFocus
Frame3.Visible = False
10 Set rs1 = Nothing

End Sub
Private Sub command10_click()
On Error Resume Next
sql = "select * from lgs where dno = " & Text10.Text
Set rs1 = Baglanti.Execute(sql)
bi = rs1("kazok")
If bi = 0 Then Text5.Text = bi
Text1.Text = rs1("dno")
Text2.Text = rs1("ad")
Text3.Text = rs1("soyad")
Text4.Text = rs1("alno")
'Text5.Text = rs1("kazok")
If IsNull(rs1("kazok")) And IsNull(rs1("tpuan")) And IsNull(rs1("fpuan")) Then
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Else
Text5.Text = rs1("kazok")
Text6.Text = rs1("tpuan")
Text7.Text = rs1("fpuan")
End If
id = rs1("id")

If Err Then
MsgBox "aradığınız kayıt bulunamadı"
GoTo 10
End If
Command3.Enabled = True
Command4.Enabled = True
Text1.Enabled = True
Text1.BackColor = &HC0FFFF
Text2.Enabled = True
Text2.BackColor = &HC0FFFF
Text3.Enabled = True
Text3.BackColor = &HC0FFFF
Text4.Enabled = True
Text4.BackColor = &HC0FFFF
Text5.Enabled = True
Text5.BackColor = &HC0FFFF
Text1.SetFocus
Frame3.Visible = False
10 Set rs1 = Nothing
End Sub


Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command7_Click

End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
On Error Resume Next
sql = "select * from okods where okkod = "' & Text5.Text & ""'
Set rs1 = Baglanti.Execute(sql)
Text5.Text = rs1("oadi")
Text5.BackColor = &HC0FFFF
If Err Then
MsgBox "aradığınız kayıt bulunamadı"
Text5.BackColor = &H80000005
GoTo 10
End If
10 Set rs1 = Nothing
Command3.SetFocus
End If
End Sub

Public Sub SelectText(txtTextBox As TextBox)
txtTextBox.SetFocus
txtTextBox.SelStart = 0
txtTextBox.SelLength = Len(txtTextBox.Text)

End Sub

Private Sub Text4_GotFocus()
SelectText Text4
End Sub


Private Sub goster_Click()
On Error Resume Next
WebBrowser1.Navigate Adres.Text
'Form1.Caption = Form1.Caption + WebBrowser1.LocationURL

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "geri"
On Error Resume Next
WebBrowser1.GoBack
End Select
Select Case Button.Key
Case "ileri"
On Error Resume Next
WebBrowser1.GoForward
End Select
Select Case Button.Key
Case "dur"
On Error Resume Next
WebBrowser1.Stop
End Select
Select Case Button.Key
Case "yenile"
On Error Resume Next
WebBrowser1.Refresh
End Select
Select Case Button.Key
Case "home"
On Error Resume Next
WebBrowser1.GoHome
End Select
Select Case Button.Key
Case "ara"
On Error Resume Next
WebBrowser1.GoSearch
End Select
Select Case Button.Key
Case "hk"
Frame4.Visible = True
End Select
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
On Error Resume Next
StatusBar1.SimpleText = "Sayfaya Bağlanıyor..." & URL
MousePointer = vbhoruglass
End Sub

Private Sub WebBrowser1_DownloadBegin()
On Error Resume Next
StatusBar1.SimpleText = "Yukleniyor"
End Sub

Private Sub WebBrowser1_DownloadComplete()
On Error Resume Next
StatusBar1.SimpleText = "Aktif sayfa :"
WebBrowser1.LocationNameURL = " & WebBrowser1.LocationURL"
MousePointer = vbDefault
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
StatusBar1.SimpleText = WebBrowser1.LocationURL
Form1.Caption = Form1.Caption + WebBrowser1.LocationURL
End Sub

Private Sub form_click()
StatusBar1.SimpleText = WebBrowser1.LocationURL
End Sub

'burası reklamınızı yapmak icin yani hakkında butonuna bastığınızda kayan yazı kısmı ,isterseniz es gecebilirsiniz

Private Sub Timer1_Timer()
Static G
G = G + 20
Frame1.Top = 3150 - G
If G = 6000 Then
G = 0
Else
End If
End Sub
__________________