Tüm kodlar aşağıdaki gibidir.
Kod:
Option Compare Text
Private con As Object, rs As Object
Sub
baglanti()
Set con = CreateObject("adodb.connection")
con.Open
"provider=microsoft.jet.oledb.4.0;data source = " & ThisWorkbook.Path &
"\hesap.mdb"
End Sub
Sub CariToplam()
Call baglanti
Dim sorgu As
String
sorgu1 = "select sum(para) as para from sil where [VADE]='Vasi Vadeli
TL'"
Set rs = con.Execute(sorgu1)
Range("Sayfa3!c10").Value =
rs("para").Value
sorgu2 = "select sum(para) as para from sil where
[VADE]='Vasi Vadeli Usd'"
Set rs =
con.Execute(sorgu2)
Range("Sayfa3!c11").Value = rs("para").Value
sorgu3 =
"select sum(para) as para from sil where [VADE]='Vasi Vadeli Euro'"
Set rs =
con.Execute(sorgu3)
Range("Sayfa3!c12").Value = rs("para").Value
sorgu4 =
"select sum(para) as para from sil where [VADE]='Vasi Vadesiz TL'"
Set rs =
con.Execute(sorgu4)
Range("Sayfa3!c13").Value = rs("para").Value
sorgu5 =
"select sum(para) as para from sil where [VADE]='Vasi Vadesiz Usd'"
Set rs =
con.Execute(sorgu5)
Range("Sayfa3!c14").Value = rs("para").Value
sorgu6 =
"select sum(para) as para from sil where [VADE]='Vasi Vadesiz Euro'"
Set rs =
con.Execute(sorgu6)
Range("Sayfa3!c15").Value = rs("para").Value
sorgu7 =
"select sum(para) as para from sil where [VADE]='Tevdi Mahalli Vadeli
Euro'"
Set rs = con.Execute(sorgu7)
Range("Sayfa3!c16").Value =
rs("para").Value
sorgu8 = "select sum(para) as para from sil where
[VADE]='Tereke Vadeli TL'"
Set rs =
con.Execute(sorgu8)
Range("Sayfa3!c17").Value = rs("para").Value
sorgu9 =
"select sum(para) as para from sil where [VADE]='Tereke Vadesiz TL'"
Set rs =
con.Execute(sorgu9)
Range("Sayfa3!c18").Value = rs("para").Value
sorgu10 =
"select sum(para) as para from sil where [VADE]='Tereke Vadeli Usd'"
Set rs =
con.Execute(sorgu10)
Range("Sayfa3!c19").Value = rs("para").Value
t1 =
Range("Sayfa3!c10")
t2 = Range("Sayfa3!c13")
t3 =
Range("Sayfa3!c17")
t4 = Range("Sayfa3!c18")
st = t1 + t2 + t3 +
t4
Range("Sayfa3!c20") = st
y1 = Range("Sayfa3!c12")
y2 =
Range("Sayfa3!c15")
y3 = Range("Sayfa3!c16")
sy = y1 + y2 +
y3
Range("Sayfa3!c21") = sy
z1 = Range("Sayfa3!c11")
z2 =
Range("Sayfa3!c14")
z3 = Range("Sayfa3!c19")
sz = z1 + z2 +
z3
Range("Sayfa3!c22") = sz
son = st + sy + sz
Range("Sayfa3!c23") =
son
End Sub
Sub AccesseKaydet()
Call baglanti
Dim i As
Integer
Set rs = CreateObject("adodb.recordset")
With
Sheets("sayfa1")
rs.Open "select * from sil", con, 1, 3
For i = 16 To
.Range("K65000").End(3).Row
rs.addnew
rs.fields(0).Value =
Cells(i, 1).Value
rs.fields(1).Value = Cells(i, 2).Value
rs.fields(2).Value = Cells(i, 3).Value
rs.fields(3).Value = Cells(i,
4).Value
rs.fields(4).Value = Cells(i, 5).Value
rs.fields(5).Value
= Cells(i, 6).Value
rs.fields(6).Value = Cells(i, 7).Value
rs.fields(7).Value = Cells(i, 8).Value
rs.fields(8).Value = Cells(i,
9).Value
rs.fields(9).Value = Cells(i, 10).Value
rs.fields(10).Value = Cells(i, 11).Value
rs.fields(11).Value = Cells(i,
12).Value
rs.fields(12).Value = Cells(i, 13).Value
rs.fields(13).Value = Cells(i, 14).Value
rs.Update
Next i
End
With
MsgBox "Kay?tlar veritaban?na aktar?ld?", vbInformation,
"Www.ExcelVBA.Net"
End Sub
Sub Verial()
Dim i As Integer, sorgu
As String
Call baglanti
Range("a16:L65535").ClearContents
Set rs =
CreateObject("adodb.recordset")
With Sheets("sayfa1")
k1 =
Range("C1")
k2 = Range("C2")
k3 = Range("C3")
k4 = Range("C4")
k5 =
Range("C5")
r1 = Range("C6")
r2 = Range("C7")
r3 = Range("C8")
r4 =
Range("C9")
r5 = Range("C10")
r6 = Range("G1")
s = "select * from sil
Where [YIL] AND [NO]"
If .Range("C1").Text <> "" Then s = s & " and
[YIL] like """ & k1 & """"
If .Range("C2").Text <> "" Then s =
s & " and [NO] like """ & k2 & """"
If .Range("C3").Text
<> "" Then s = s & " and [DOSYAES] like """ & k3 & """"
If
.Range("C4").Text <> "" Then s = s & " and [TARİH] like """ & k4
& """"
If .Range("C5").Text <> "" Then s = s & " and [HESAPNO]
like """ & k5 & """"
If .Range("C6").Text <> "" Then s = s
& " and [ACIKLAMA] like ""%" & r1 & "%"""
If .Range("C7").Text
<> "" Then s = s & " and [TLDÖVİZ] like """ & r2 &
"%"""
If .Range("C8").Text <> "" Then s = s & " and [VADE] like
""" & r3 & """"
If .Range("C9").Text <> "" Then s = s & "
and [PARA] like """ & r4 & """"
If .Range("C10").Text <> ""
Then s = s & " and [DURUM] like ""%" & r5 & "%"""
If
.Range("G1").Text <> "" Then s = s & " and [OZET] like ""%" & r6
& "%"""
s = s & " order by [YIL],[NO]"
rs.Open s, con, 1,
1
Range("a16").CopyFromRecordset rs
If
WorksheetFunction.Count(Range("A16:A65000").Value) Then
toplambulunan =
WorksheetFunction.Count(Range("A16:A65000").Value)
Range("Sayfa1!I4").Value
= toplambulunan
Exit Sub
End If
Range("A65000").End(xlUp).Offset(1,
0).Select
End With
End Sub
Sub
Temizle()
Range("a16:N65535").ClearContents
If
WorksheetFunction.CountA(Range("A16:N65000")) = 0 Then
bulunamayan =
WorksheetFunction.CountA(Range("A16:N65000")) = 0
ar = bulunamayan + 1
Range("Sayfa1!I4").Value = ar
Exit Sub
End
If
Range("A16").Select
End Sub
Sub FaturaGuncelle()
Dim
satir As Range
Dim boshucre As Range
For Each satir In
Range("A16:I16")
If satir = Empty Then
MsgBox ("BOŞ HÜCRE VAR GÜNCELLEME
YAPILMADI")
Exit Sub
End If
Next
Dim SutunSay, SatirSay,
SatirSay2, x As Long
SutunSay = 14
SatirSay = Cells(16,
1).End(xlDown).Row
For x = 2 To SutunSay
SatirSay2 = Cells(16,
x).End(xlDown).Row
If SatirSay <> SatirSay2 Then
MsgBox ("Boş
veri var güncelleme iptal edildi")
Exit Sub
End If
Next x
MsgBox
("BİLGİLER VERİ TABANINA AKTARILDI")
Dim i As Integer
With
Sheets("sayfa1")
Call baglanti
For i = 16 To
.Range("L65536").End(3).Row
U1 = Cells(i, 1).Value
U2 = Cells(i,
2).Value
U3 = Cells(i, 3).Value
U4 = Cells(i, 4).Value
U5 = Cells(i,
5).Value
U6 = Cells(i, 6).Value
U7 = Cells(i, 7).Value
U8 = Cells(i,
8).Value
U9 = Cells(i, 9).Value
U10 = Cells(i, 10).Value
U11 = Cells(i,
11).Value
U12 = Cells(i, 12).Value
U13 = Cells(i, 13).Value
U14 =
Cells(i, 14).Value
sorgu = "select * from sil where [SIRA]=" & U1 & "
AND [YIL]=" & U2 & " AND [NO]=" & U3 & ""
Set rs =
CreateObject("adodb.recordset")
rs.Open sorgu, con, 1, 3
rs.fields(0).Value = U1
rs.fields(1).Value = U2
rs.fields(2).Value
= U3
rs.fields(3).Value = U4
rs.fields(4).Value = U5
rs.fields(5).Value = U6
rs.fields(6).Value = U7
rs.fields(7).Value
= U8
rs.fields(8).Value = U9
rs.fields(9).Value = U10
rs.fields(10).Value = U11
rs.fields(11).Value = U12
rs.fields(12).Value = U13
rs.fields(12).Value = U14
rs.Update
Next i
End With
End Sub
Sub say()
Call
baglanti
Dim sorgu As String
sorgu = "SELECT COUNT(NO) AS YIL FROM
sil"
Set rs = con.Execute(sorgu)
e = rs("YIL").Value
f = e +
1
Range("Sayfa1!f8").Value = f
End Sub