Skip to main content

AccessTr.neT


Excel'e Access'ten Şablona Veri Alma

Excel'e Access'ten Şablona Veri Alma

#19
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
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
Son Düzenleme: 03/03/2020, 11:17, Düzenleyen: erhan3479.
Cevapla
#20
(03/03/2020, 11:09)erhan3479 yazdı: 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
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
Task