DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Tarkan VURAL' Alıntı:. dbf dosyanız kapalıyken yapmak istiyorsanız ado bağlantı kurup verileri okutup kodlarla aktarabilirsiniz.
Private Sub CommandButton1_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Excel\SQL ADO\Veritabani.xls;Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [Veritabani$]"
kayit.Open Nsql, baglan, 1, 3
kayit.AddNew
kayit("AdiSoyadi") = TextBox1
kayit("ikameti") = TextBox2
kayit("Meslek") = TextBox3
kayit.Update
baglan.Close
End Sub
Option Explicit
Dim pbaglanti As ADODB.Connection, pdata As ADODB.Recordset, psqlado As String
Dim Txtad As String, Txtfiyat, Txtadet As Single
Dim ekleme, bul As Range
Private Sub Kapat_Click()
Unload Me
End Sub
Private Sub parcalar_Click()
If parcalar.Value = "" Then
MsgBox "Boş alana tıkladınız, lütfen dolu satır üzerine tıklayınız", _
vbInformation, "Uyarı "
Exit Sub
Else
pno.Value = parcalar
End If
For Each bul In Worksheets("envanter").Range("pkodlar")
If bul.Value = pno.Value Then
Rows(bul.Row).Select
End If
Next bul
End Sub
Private Sub UserForm_Initialize()
With parcalar
.RowSource = "envanter!a2:l65535"
.ColumnCount = 12
.ColumnWidths = 80 & ";" & 120 & ";" & 40 & ";" & 40 & ";" & 70 _
& ";" & 40 & ";" & 70 & ";" & 40 & ";" & 40 & ";" & 40 & ";" & 70 & ";" & 50
.ColumnHeads = True
End With
pno.SetFocus
End Sub
Private Sub UserForm_Terminate()
pbaglanti.Close
End Sub
Private Sub sil_click()
If ActiveCell.Value = Empty Then
MsgBox "Silinecek satır bulunamadı", _
vbInformation, "Hata !!!"
End If
parcalar.Value = Empty
Selection.Delete Shift:=xlUp
Range("A1:A200").Select
ActiveWorkbook.Names.Add Name:="pkodlar", RefersToR1C1:="=envanter!R2C1:R65536C1"
Range("a2").Select
pno.Value = ""
pno.SetFocus
End Sub
Public Sub ekle_Click()
If pno.Value = Empty Then
MsgBox "Parça numarası boş bırakılamaz", vbInformation, "Parça kodu bulunamadı"
pno.SetFocus
Exit Sub
Exit Sub
ElseIf padet.Value = Empty Then MsgBox "Parça talep adedi boş bırakılamaz", _
vbInformation, "Talep adedi bulunamadı"
padet.SetFocus
Exit Sub
ElseIf Not IsNumeric(padet.Value) Then
MsgBox "Parça talep adedi sayısal olmalıdır", vbExclamation, "Hatalı Değer Girildi"
padet.Value = ""
padet.SetFocus
Exit Sub
Exit Sub
End If
pno.Value = UCase(pno.Value)
If aciklama.Caption = "CITROÃ?N" Then
Set pbaglanti = New ADODB.Connection
pbaglanti.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Sayım Dosyaları\CitroenStok.xls;Readonly=True"
Set pdata = New ADODB.Recordset
psqlado = "SELECT * FROM [Citroen$] WHERE parcano='" & pno.Text & "'"
pdata.Open psqlado, pbaglanti, 1, 3
ElseIf aciklama.Caption = "NISSAN" Then
Set pbaglanti = New ADODB.Connection
pbaglanti.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Sayım Dosyaları\NissanStok.xls;Readonly=True"
Set pdata = New ADODB.Recordset
psqlado = "SELECT * FROM [Nissan$] WHERE parcano='" & pno.Text & "'"
pdata.Open psqlado, pbaglanti, 1, 3
ElseIf aciklama.Caption = "SUBARU" Then
Set pbaglanti = New ADODB.Connection
pbaglanti.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Sayım Dosyaları\SubaruStok.xls;Readonly=True"
Set pdata = New ADODB.Recordset
psqlado = "SELECT * FROM [Subaru$] WHERE parcano='" & pno.Text & "'"
pdata.Open psqlado, pbaglanti, 1, 3
ElseIf aciklama.Caption = "MITSUBISHI" Then
Set pbaglanti = New ADODB.Connection
pbaglanti.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Sayım Dosyaları\MitsubishiStok.xls;Readonly=True"
Set pdata = New ADODB.Recordset
psqlado = "SELECT * FROM [Mitsubishi$] WHERE parcano='" & pno.Text & "'"
pdata.Open psqlado, pbaglanti, 1, 3
ElseIf aciklama.Caption = "KIA" Then
Set pbaglanti = New ADODB.Connection
pbaglanti.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & "C:\Sayım Dosyaları\KiaStok.xls;Readonly=True"
Set pdata = New ADODB.Recordset
psqlado = "SELECT * FROM [Kia$] WHERE parcano='" & pno.Text & "'"
pdata.Open psqlado, pbaglanti, 1, 3
On Error Resume Next
End If
If Not pdata.EOF Then
Txtad = pdata!parcaadi
Txtfiyat = pdata!birimmaliyet
Txtadet = pdata!StokAdedi
Else
MsgBox "Parça kayıdı database'de bulunamadı", vbInformation, "Kayıt Bulunamadı"
padet.Value = ""
pno.SetFocus
Exit Sub
End If
If ActiveCell.Offset(1, 0).Value = Empty Then
For Each ekleme In Worksheets("envanter").Range("pkodlar")
If ekleme.Value = pno.Value Then
Rows(ekleme.Row).Select
MsgBox "Aynı Parça Daha Ã?nce Girilmiş", vbInformation, "Uyarı "
uyari.Show
Else
GoTo devam
End If
Exit Sub
Next ekleme
Exit Sub
devam:
Worksheets("envanter").Select
Range("a65536").Select
Selection.End(xlUp)(2, 1).Select
ActiveCell.Offset(0, 0).Value = menu.pno.Value
ActiveCell.Offset(0, 1).Value = Txtad
ActiveCell.Offset(0, 2).Value = Txtadet
ActiveCell.Offset(0, 3).Value = Txtfiyat
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, 2).Value _
* ActiveCell.Offset(0, 3).Value
ActiveCell.Offset(0, 5).Value = menu.padet.Value
ActiveCell.Offset(0, 6).Value = ActiveCell.Offset(0, 3).Value _
* ActiveCell.Offset(0, 5).Value
If menu.parttir.Value = Empty Then menu.parttir.Value = 0
If menu.peksilt.Value = Empty Then menu.peksilt.Value = 0
ActiveCell.Offset(0, 7).Value = menu.parttir.Value
ActiveCell.Offset(0, 8).Value = menu.peksilt.Value
ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(0, 5).Value _
- ActiveCell.Offset(0, 2).Value + ActiveCell.Offset(0, 7).Value _
- ActiveCell.Offset(0, 8).Value
ActiveCell.Offset(0, 10).Value = ActiveCell.Offset(0, 9).Value _
* ActiveCell.Offset(0, 3).Value
If ActiveCell.Offset(0, 0).Value = Empty Then
ActiveCell.Offset(0, 11).Value = Empty
ElseIf ActiveCell.Offset(0, 10).Value = 0 Then
ActiveCell.Offset(0, 11).Value = "Tam"
ElseIf ActiveCell.Offset(0, 10).Value < 0 Then
ActiveCell.Offset(0, 11).Value = "Eksik"
ElseIf ActiveCell.Offset(0, 10).Value > 0 Then
ActiveCell.Offset(0, 11).Value = "Fazla"
End If
menu.aciklama2.Caption = "Kaydedildi..."
Set pdata = Nothing
Exit Sub
End If
End Sub
Option Explicit
Private Sub opilk_Change()
If uyari.opilk.Value = True Then
uyari.ilk.Visible = True
Else
uyari.ilk.Visible = False
End If
End Sub
Private Sub opyeni_Change()
If uyari.opyeni.Value = True Then
uyari.yeni.Visible = True
Else
uyari.yeni.Visible = False
End If
End Sub
Private Sub optopla_Change()
If uyari.optopla.Value = True Then
uyari.topla.Visible = True
Else
uyari.topla.Visible = False
End If
End Sub
Private Sub opcik_Change()
If uyari.opcik.Value = True Then
uyari.cik.Visible = True
Else
uyari.cik.Visible = False
End If
End Sub
Private Sub tamam_Click()
If uyari.opilk.Value = True Then
ActiveCell.Offset(0, 5).Value = uyari.ilk.Value
ElseIf uyari.opcik.Value = True Then
ActiveCell.Offset(0, 5).Value = uyari.cik.Value
ElseIf uyari.optopla.Value = True Then
ActiveCell.Offset(0, 5).Value = uyari.topla.Value
ElseIf uyari.opyeni.Value = True Then
ActiveCell.Offset(0, 5).Value = uyari.yeni.Value
End If
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, 2).Value _
* ActiveCell.Offset(0, 3).Value
ActiveCell.Offset(0, 6).Value = ActiveCell.Offset(0, 3).Value _
* ActiveCell.Offset(0, 5).Value
If menu.parttir.Value = Empty Then menu.parttir.Value = 0
If menu.peksilt.Value = Empty Then menu.peksilt.Value = 0
ActiveCell.Offset(0, 7).Value = menu.parttir.Value
ActiveCell.Offset(0, 8).Value = menu.peksilt.Value
ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(0, 5).Value _
- ActiveCell.Offset(0, 2).Value + ActiveCell.Offset(0, 7).Value _
- ActiveCell.Offset(0, 8).Value
ActiveCell.Offset(0, 10).Value = ActiveCell.Offset(0, 9).Value _
* ActiveCell.Offset(0, 3).Value
If ActiveCell.Offset(0, 0).Value = Empty Then
ActiveCell.Offset(0, 11).Value = Empty
ElseIf ActiveCell.Offset(0, 10).Value = 0 Then
ActiveCell.Offset(0, 11).Value = "Tam"
ElseIf ActiveCell.Offset(0, 10).Value < 0 Then
ActiveCell.Offset(0, 11).Value = "Eksik"
ElseIf ActiveCell.Offset(0, 10).Value > 0 Then
ActiveCell.Offset(0, 11).Value = "Fazla"
End If
menu.aciklama2.Caption = "Kaydedildi..."
Unload Me
End Sub
Private Sub UserForm_Initialize()
Worksheets("envanter").Select
uyari.ilk.Value = ActiveCell.Offset(0, 5).Value
uyari.yeni.Value = menu.padet.Value
uyari.topla.Value = ActiveCell.Offset(0, 5).Value _
+ menu.padet.Value
uyari.cik.Value = ActiveCell.Offset(0, 5).Value
End Sub