Webmaster Sitesi > Programlama > Visual Basic & Action script

LGS Sonuçlarını Veri Tabanınıza Hızlı Bir Şekilde Ekleyin

Visual Basic & Action script LGS Sonuçlarını Veri Tabanınıza Hızlı Bir Şekilde Ekleyin Programlama hakkında bilgi paylaş; ‘Önce değişkenler Dim MyExcel As Object Dim MyChart As Object Dim i Dim db As Database Dim ...
Cevapla Yeni Konu aç
 
Seçenekler
  #1  
Arama 24-01-2008
Banlı
Üyelik Tarihi: 18/09/07
Mesajlar: 1.904
 
     WS-Ticareti: (1)
Blog Yazıları: 1
Teşekkürleri: 0
20 Msg. 27 Tşkr.
Rep Gücü: 0 B737 rep gücü epey yüksek

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
Alıntı ile Cevapla
Sponsorlar
Seo Kursu
Trafik Yaratın!
www.Akiza.com
Burada Reklam Verin
Reklamınız

Text Banner Reklam
Cevapla
 

 
Seçenekler


Benzer Konular
Konu Konu Açanlar Forum Cevaplar Güncel Mesajlar
PR 2 Çok hızlı bir şekilde çapraz link takası CMDizayn Oyun siteleri 8 16-05-2008 02:06
Arama İçin AdSense sonuçlarını kendi sayfama nasıl uygularım? kadınca Google Adsense 1 29-03-2008 09:12
Hızlı cevap bölümüne smiley ekleyin tafki SMF 2 29-03-2008 03:02
Veri tabanındaki belirli bir veri tipini otomatik değiştirme B737 Veritabanı programcılığı 0 24-02-2008 04:13
Hızlı Bir Şekilde Photoshop Kullanarak Su Damlacıkları Oluşturmak Professionel Photoshop 0 24-11-2007 03:22

Text Reklam: facebook ~

Yapacağınız alıntılarda sitemize (http://webmastersitesi.com) link veriniz. "Bilgi paylaştıkça çoğalır."