Skip to main content

AccessTr.neT M.


Excel'e Access'ten Şablona Veri Alma

Excel'e Access'ten Şablona Veri Alma

#19
Son Düzenleme: 03/03/2020, 11:17, Düzenleyen: erhan3479.
Hocam birde dikkatimi yeni çekti siz giriş veya çıkış olarak tümünü eklemişsiniz ama ben aşağıdaki gibi kırmızı yerleri ekleme yaptım

PHP Kod:

Private Sub CommandButton21_Click()
Dim ra As Range
Dim SonVeri As Long

Dim baglan As New Connection
Dim rs As New Recordset
Dim Teslim As Worksheet
Dim rs2 As New Recordset
Dim a
a = "çıkış"
baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\veri.accdb;"
rs2.Open "select DISTINCT kisi from  giriscikis where ilce='" & Me.ComboBox5 & "' and yer='" & Me.ComboBox6 & "' ", baglan, adOpenKeyset, adLockPessimistic

sgl1 = " SELECT giriscikis.mlz_ad,'','','', Sum(giriscikis.mlz_miktar) AS TplMiktar, giriscikis.birim " & _
        " FROM giriscikis " & _
        " WHERE (((giriscikis.tarih) Between " & CLng(CDate(Me.TextBox16.Value)) & " And " & CLng(CDate(Me.TextBox17.Value)) & _
        " ) AND ((giriscikis.ilce)='" & Me.ComboBox5 & "')AND ((giriscikis.durum)='" & a & "') AND ((giriscikis.yer)='" & Me.ComboBox6 & "'))" & _
        " GROUP BY giriscikis.mlz_ad, giriscikis.birim"

rs.Open sgl1, baglan, adOpenKeyset, adLockPessimistic
    Set Teslim = Worksheets("teslim_senedi")
    Set ra = Teslim.Cells.Find(What:="Kalem Malzemeyi ", LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Debug.Print "rs.RecordCount", rs.RecordCount
SonVeri = ra.Row - 1
If SonVeri > 20 Then
    Teslim.Rows(20 & ":" & SonVeri).Delete
End If

If rs.RecordCount > 12 Then
    For X = 1 To rs.RecordCount - 12
        Teslim.Rows(20).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Teslim.Range("B20:E20").Merge (True)
    Next X
End If
Teslim.Range("C5") = ""
Teslim.Range("B8:G19").ClearContents
Teslim.Range("C5") = CStr(Me.ComboBox5.Value) & " " & CStr(ComboBox6.Value)
Teslim.Range("f22").CopyFromRecordset rs2
Teslim.Range("B8").CopyFromRecordset rs
Teslim.Range("A8:G" & 7 + rs.RecordCount).Borders.LineStyle = xlContinuous

rs.Close
rs2.Close
baglan.Close
    Set ra = Teslim.Cells.Find(What:="Kalem Malzemeyi ", LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Debug.Print "ra  ", ra.Row

End Sub

Cevapla
#20
(03/03/2020 11:09)erhan3479 Adlı Kullanıcıdan Alıntı: siz giriş veya çıkış olarak tümünü eklemişsiniz ama ben aşağıdaki gibi kırmızı yerleri ekleme yaptım
kastettiğiniz şeyi anlamadım sizin bahsettiğiniz kriterlere göre almıyor mu verileri?
sizin belirlediğiniz kriterler
1 - ilçe
2 - yer
3 -4: başlangıç ve bitiş tarihleri
sorgu kaynağına dikkat ederseniz zaten bu 4 kritere göre alıyor
" WHERE (((giriscikis.tarih) Between " & CLng(CDate(Me.TextBox16.Value)) & " And " & CLng(CDate(Me.TextBox17.Value)) & _
" ) AND ((giriscikis.ilce)='" & Me.ComboBox5 & "') AND ((giriscikis.yer)='" & Me.ComboBox6 & "'))"


aşağıdaki kodda teslim alan kişi de eklenmiştir

Visual Basic Code
Dim ra As Range
Dim SonVeri As Long

Dim baglan As New Connection
Dim rs As New Recordset
Dim Teslim As Worksheet

baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\veri.accdb;"

 sgl1 = " SELECT giriscikis.mlz_ad,'','','', Sum(giriscikis.mlz_miktar) AS TplMiktar, giriscikis.birim, giriscikis.kisi " & _
        " FROM giriscikis " & _
        " WHERE (((giriscikis.tarih) Between " & CLng(CDate(Me.TextBox16.Value)) & " And " & CLng(CDate(Me.TextBox17.Value)) & _
        " ) AND ((giriscikis.ilce)='" & Me.ComboBox5 & "') AND ((giriscikis.yer)='" & Me.ComboBox6 & "'))" & _
        " GROUP BY giriscikis.mlz_ad, giriscikis.birim, giriscikis.kisi"

rs.Open sgl1, baglan, adOpenKeyset, adLockPessimistic

    Set Teslim = Worksheets("teslim_senedi")
    Set ra = Teslim.Cells.Find(What:="Kalem Malzemeyi ", LookAt:=xlPart, SearchOrder:=xlByRows, _
             SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

SonVeri = ra.Row - 1
If SonVeri > 20 Then Teslim.Rows(20 & ":" & SonVeri).Delete
Teslim.Range("C5") = ""
Teslim.Range("B8:G19").ClearContents

If rs.RecordCount = 0 Then
    rs.Close
    baglan.Close
    MsgBox "Uygun kayıt bulunamamıştır"
    Exit Sub
End If

Application.ScreenUpdating = False
rs.MoveFirst
Teslim.Range("F22").Value = rs(6)

If rs.RecordCount > 12 Then
    For X = 1 To rs.RecordCount - 12
        Teslim.Rows(20).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Teslim.Range("B20:E20").Merge (True)
        Teslim.Range("B20:E20").HorizontalAlignment = xlLeft
        Teslim.Range("A20").Value = rs.RecordCount - X + 1
    Next X
End If

Teslim.Range("C5") = CStr(Me.ComboBox5.Value) & " " & CStr(ComboBox6.Value)

Teslim.Range("B8").CopyFromRecordset rs, , 6
Teslim.Range("A8:G" & 7 + rs.RecordCount).Borders.LineStyle = xlContinuous

rs.Close
baglan.Close
Application.ScreenUpdating = True

Cevapla
...........
#21
Hocam o sorunları ben yukarıda gönderdiğim kod ile hallettim. Teşekkürler bahsettiğiniz gibi bu programı  Access de yapabilirmisiniz?

Cevapla
#22
ücreti mukabilinde yaptırmak isterseniz İletişim bağlantısına tıklayarak yönetimle iletişime geçebilirsiniz ama onun dışında formun amacı sadece yardımcı olup yol göstermektir, baştan sona proje yapmıyoruz.

Cevapla
...........
#23
Teşekkürler ben Access te birşeyler yapmaya çalışayım takıldığımda umarım yardımcı olursunuz.

Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da