![]() |
|
| |||||||
|
| | Seçenekler |
|
#1
| |||
| | |||
LGS Sonuçlarını Veri Tabanınıza Hızlı Bir Şekilde Ekleyin‘Önce 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 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 üzerindesiniz” 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 üzerindesiniz” 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 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 ‘ Aplikasyonumuzu mutlaka visible=true etmeliyiz yoksa çalışmayacaktır(!!!). MyExcel.Workbooks.Add ‘ Gayet Açık yeni bir Çalışma kitabi yani excel belgesi oluşturuyor.. ‘////////////////////////////////////////////////// ‘Eğer varolan bir excel sayfasını açmak isterseniz; ‘MyExcel.Workbooks.Open (”DosyaAdi”) ‘komutunu kullanmalısınız. ‘///////////////////////////////////////////////// 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 ‘Şimdi Databasemizdeki Users tablosundaki tüm değerleri Excel e aktaralım. ‘Cursorun ilk kayitta oldugundan emin olmak için rs.MoveFirst ‘ilk satira başlıkları yazdırmıştık.2.satırdan başlayarak kayıtlarımızı yazdıralım. i = 2 ‘şimdi sıra döngümüzde 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 ‘////////////////////////////////////////////////// ‘Sıra geldi Excel i kapatmaya (tabi istersek) ‘MyExcel.Workbooks(1).Close (True) ‘MyExcel.Application.Quit ‘Set MyExcel = Nothing ‘////////////////////////////////////////////////// If Err Then MsgBox “Tüm 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 Öğ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 (”Böyle bir Öğrenci kayıtlı! Lütfen 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={Microsoft Access Driver (*.mdb)}; 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 = “Yükleniyor” 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 Private Sub Timer1_Timer() Static G G = G + 20 Frame1.Top = 3150 - G If G = 6000 Then G = 0 Else End If End Sub |
| Sponsorlar | |||
|