- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub ComboBox1_Change()
'nüfusa kayıtlı olduğu il
Call DegiskenTani
On Error Resume Next
Dim Baglanti As ADODB.Connection: Dim Kayit1 As ADODB.Recordset: Dim SQLStr As String
Dim i As Integer
'ckBU_Klc_SfAd = Array(ckBU_sfSAT.Name, ckBU_sfALS.Name, ckBU_sfTNM.Name, ckBU_sfTSB.Name, _
ckBU_sfAYL.Name, ckBU_sfYIL.Name, ckBU_sfDVR.Name) 'daima bu kitapta kalacak sayfa adları
SQLStr = "SELECT DISTINCT il, ilce FROM [ilveilce$] WHERE il=" & "'" & ComboBox1.Value & "'"
'************************************************'kynMHBRM dosya varsa bağlan>
If Dir(kynMHBRM) = "" Then
MsgBox kynMHBRM & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
Exit Sub
End If
Set Baglanti = CreateObject("ADODB.Connection")
With Baglanti
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Properties("Data Source").Value = kynMHBRM
.CursorLocation = adUseClient
.Mode = adModeReadWrite
.CommandTimeout = 60
'.Properties("User ID") = vbNullString
'.Properties("Password") = vbNullString
.Open
End With
Set Kayit1 = CreateObject("ADODB.Recordset")
With Kayit1
.ActiveConnection = Baglanti
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = SQLStr
.Open
End With '<bitti
'************************************************'bitti<
'************************************************'verileri çek
Kayit1.MoveFirst: ComboBox2.Clear
For i = 1 To Kayit1.RecordCount
ComboBox2.AddItem Kayit1.Fields("ilce")
Kayit1.MoveNext
Next i
Kayit1.MoveFirst
If ComboBox1.ListIndex = 27 Then ComboBox2.ListIndex = 2
If ComboBox1.ListIndex <> 27 Then ComboBox2.ListIndex = 0
'************************************************'bağlantıyı kes
If CBool(Kayit1.State And adStateOpen) = True Then Kayit1.Close: Set Kayit1 = Nothing
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close: Set Baglanti = Nothing 'bitti
End Sub
Private Sub ComboBox2_Change()
'nüfusa kayıtlı olduğu ilçe
Call DegiskenTani
On Error Resume Next
Dim Baglanti As ADODB.Connection: Dim Kayit1 As ADODB.Recordset: Dim SQLStr As String
Dim i As Integer
SQLStr = "SELECT DISTINCT il, ilce,mahkoy FROM [ilveilce$] WHERE il=" & "'" & ComboBox1.Value & "'" & "AND ilce=" & "'" & ComboBox2.Value & "'"
'************************************************'kynMHBRM dosya varsa bağlan>
If Dir(kynMHBRM) = "" Then
MsgBox kynMHBRM & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
Exit Sub
End If
Set Baglanti = CreateObject("ADODB.Connection")
With Baglanti
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Properties("Data Source").Value = kynMHBRM
.CursorLocation = adUseClient
.Mode = adModeReadWrite
.CommandTimeout = 60
'.Properties("User ID") = vbNullString
'.Properties("Password") = vbNullString
.Open
End With
Set Kayit1 = CreateObject("ADODB.Recordset")
With Kayit1
.ActiveConnection = Baglanti
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = SQLStr
.Open
End With '<bitti
'************************************************'bitti<
'************************************************'verileri çek
Kayit1.MoveFirst: ComboBox3.Clear
For i = 1 To Kayit1.RecordCount
ComboBox3.AddItem Kayit1.Fields("mahkoy")
Kayit1.MoveNext
Next i
Kayit1.MoveFirst
If Me.ComboBox1.Value <> "" Then ComboBox3.ListIndex = 0
'************************************************'bağlantıyı kes
If CBool(Kayit1.State And adStateOpen) = True Then Kayit1.Close: Set Kayit1 = Nothing
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close: Set Baglanti = Nothing 'bitti
End Subyukarıdaki kodlardanda anlaşılacağı üzere
Kod:
.........
'************************************************'kynMHBRM dosya varsa bağlan>
If Dir(kynMHBRM) = "" Then
MsgBox kynMHBRM & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
Exit Sub
End If
Set Baglanti = CreateObject("ADODB.Connection")
With Baglanti
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Properties("Data Source").Value = kynMHBRM
.CursorLocation = adUseClient
.Mode = adModeReadWrite
.CommandTimeout = 60
'.Properties("User ID") = vbNullString
'.Properties("Password") = vbNullString
.Open
End With
Set Kayit1 = CreateObject("ADODB.Recordset")
With Kayit1
.ActiveConnection = Baglanti
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = SQLStr
.Open
End With '<bitti
'************************************************'bitti<mesala
call vtMBRM_ac çağırıp işlem bitince vtMBRM_kapa ile kapa demenin yolu varmıdır.
