Bir veri tabanı üzerinde çalışma

jajiyiko · 11 Mayıs 2005

Merhaba!

Sizden şöyle bir ricam var. Bir veritabanının (örnek dbf dosya) bir alanını (örnek "adresi") bir diziye aktarıp oradan daexcel sayfasına aktarabilirmiyiz.?
Teşekkürler

Tarkan VURAL · 11 Mayıs 2005

. dbf dosyanız kapalıyken yapmak istiyorsanız ado bağlantı kurup verileri okutup kodlarla aktarabilirsiniz.

Mahmut1950 · 11 Mayıs 2005

1) .dbf dosyası açık iken oluyordamı dosyanız kapalıyken denmiş.
2) Madem cevap verilmiş nasıl olacağıda anlatılmalıydı değil mi?

Tarkan VURAL · 12 Mayıs 2005

Sayın Mahmut1950 sizin de mi böyle bir sorununuz var?
Sorunuzu sorun dilerseniz ayrıntılı açıklamayı yapmaya çalışalım.

danersin · 12 Mayıs 2005

Bugün yolladığı her mesajda Mahmut1950 takma adlı üyenin
bilgi paylaşmak ve yardımlaşmak gibi bir amaçla forumda bulunmadığı
açıkca belli olduğu için tarafımdan BANlanmıştır. Kendisine
seviyesine uygun forumlarda başarılar diliyorum.

http://www.excel.web.tr/viewtopic.php?p=24671#24671
http://www.excel.web.tr/viewtopic.php?p=24668#24668
http://www.excel.web.tr/viewtopic.php?p=24670#24670

cako · 12 Mayıs 2005

danersin arkadaşım.
:bravo: :bravo:
ben de iki de bir bu adam ne kadar daha devam edecek diye bakıyordum.
tebrikler danersin.

vba_man · 13 Mayıs 2005

Tarkan VURAL' Alıntı:
. dbf dosyanız kapalıyken yapmak istiyorsanız ado bağlantı kurup verileri okutup kodlarla aktarabilirsiniz.

Tam istediğim olay. @Tarkan Benim bir Excel sayfam var ve onu VeriTabanı olarak kullanmak istiyorum, ancak bu işlemleri Çalışma kitabı açılmadan yapmalı. VeriTabanı olarak kullanacağım bu sayfada verileri buldurup sildirmekde isterim. Yardımcı olurmusunuz?

Güzel bir sitede şöyle kodlar görmüştüm, ancak bulup silme işlemi için ne yapmalıyım cevaplarmısınız?

Kod:

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

Tarkan VURAL · 15 Mayıs 2005

Ãu an çalıştığım iş ile ilgili yapmakta olduğum bir çalışmayı paylaşabilirim. Sanırım istediğin cevabı burada bulabilirsin. Ben listbox kullanarak işlemlerimi yaptırıyorum. aşağıdaki kodları menu userform için yazdım:
ekle = commandbutton
kapat=commandbutton
parcalar=listbox
sil=commandbutton
Bu kodlardan sil adlı makroyu incelemeni tavsiye ederim.
Henüz son kontrollerimi yapmadan forumdaki sorunuzu gördüğümden yazdıklarımı olduğu gibi aşağıya yapıştırıyorum.
UserForm adını menu yaptım

Kod:

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

Kod:

Private Sub Kapat_Click()
Unload Me
End Sub

Kod:

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

Kod:

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

Kod:

Private Sub UserForm_Terminate()
pbaglanti.Close
End Sub

Kod:

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

Kod:

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

2.Userform adını uyari yaptım
bu da mükerrer kayıt girişinde programın tutumunu denetliyor.
Girilen mükerrer kayıt ile ne yapılacağına karar veriyor.

Kod:

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

Kod:

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

Kod:

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

Biraz uzunca olduğunun farkındayım, belki yararlanmak isteyen arkadaşlar olacağını düşündüğümden hemen hemen tamamını paylaşmak istedim.
Burada dikkat edilmesi gereken en önemli nokta öncelikle ado bağlantısının referansını tanıtmak. Microsoft Activex Data Object 2.# library tanıtmayı unutmamalı.
İkinci ayrıntı bağlanılacak dosya adının sürücü ve klasör adlarının tam ve doğru olarak belirtilmesi.
Bir üçüncü ayrıntı hangi dosyadan hangi sütüna veri ekleneceği yada hangi sütündan veri okutulacağı yada silineceği konusudur.

Umarım aradığınız sorunun cevabını buradan çözebilirsiniz.
Kolay gelsin.

Saygılarımla;
Tarkan VURAL