Bir sorgu içerisindeki koşula uygun olanlar ile gecici tablolar oluşturturuyorum.
Bu oluşturttuğum geçici tablolardan sırasıyla Excel kitabındaki sayfalara başka verileri aktarmak istiyorum. Bir türlü beceremedim çalışma falan herşeyi sildim
Nerede hata yapıyorum veya Daha iyi bir önerisi olan var mı
Kod:
DoCmd.SetWarnings False
If MsgBox("Bilgileriniz Excele Aktarılsın mı?", vbCritical + vbYesNo + vbDefaultButton1, "UYARI") = vbNo Then Exit Sub
MsgBox "Aktarma İşlemi BİP sesini Duyana Kadar Devam Edecektir Excel Açıldıktan Sonra Hücrelere Tıklarsanız Eksik veya Hatalı Aktarabilir. Bilgisayarınızın Sesi Açık Olduğundan Emin Olunuz.", vbDefaultButton1, "UYARI!!!"
Dim rs As Excel.Application
Dim KTP1 As Excel.Workbook
Dim SYF As Excel.Worksheet
Set Excl = New Excel.Application
With Excl
.Application.Visible = True
.UserControl = True
End With
Set KTP1 = Excl.Workbooks.Open(CurrentProject.Path & "\EXCEL TABLOLARI\Malzemeci.xlsx")
Set Rs1 = CurrentDb.OpenRecordset("Alinan_Malzeme_Giris")
Set Rs3 = CurrentDb.OpenRecordset("Alinan_Malzeme_Giris")
'################### gecici tablo oluşturma #########################
Dim ğ
ğ = 1
Do Until Rs3.EOF
Me.Metin1 = Rs1(2)
DoCmd.RunSQL "SELECT srg_Malzemeci_Cizelgesi.Harcanan_ID, srg_Malzemeci_Cizelgesi.Malzeme_Miktari, srg_Malzemeci_Cizelgesi.Malzeme_Markasi, srg_Malzemeci_Cizelgesi.Malzeme_Adi, srg_Malzemeci_Cizelgesi.Malzeme_Seri_No, srg_Malzemeci_Cizelgesi.Sorusturma, srg_Malzemeci_Cizelgesi.Malzeme_Alindigi_Tarih, srg_Malzemeci_Cizelgesi.TSG, srg_Malzemeci_Cizelgesi.Adi_Soyadi, srg_Malzemeci_Cizelgesi.Sahis_Adi_Soyadi INTO gecici_malzemeci" & ğ & " FROM srg_Malzemeci_Cizelgesi WHERE (((srg_Malzemeci_Cizelgesi.Malzeme_Adi)=IIf([Formlar]![frm_excel]![Metin1]='(Hepsi)',[Malzeme_Adi],[Formlar]![frm_excel]![Metin1])))"
ğ = ğ + 1
Rs3.MoveNext
Loop
Rs3.Close
Dim ş
ş = 1
Do Until Rs1.EOF
Me.Metin1 = Rs1(2)
Set Rs2 = CurrentDb.OpenRecordset("gecici_malzemeci" & ş)
SyfAdi = Rs1(1) & " " & Rs1(2)
SyfAdiTmp = SyfAdi
SyfNo = 0
Do While WorksheetExists(SyfAdiTmp, KTP1) = True
SyfNo = SyfNo + 1
SyfAdiTmp = SyfAdi & IIf(SyfNo = 0, "", "(" & SyfNo & ")")
Loop
Excl.Sheets.Add.Name = SyfAdiTmp
'BAŞLIKLAR
Excl.Range("A" & ş) = Rs1(1) & " " & Rs1(2)
Excl.Range("A" & ş + 1) = "V.MİKTAR"
Excl.Range("C" & ş + 1) = "K.MİKTAR"
Excl.Range("E" & ş + 1) = "KULLANILAN MİKTAR"
Excl.Range("A" & ş + 2) = "SIRA NO"
Excl.Range("B" & ş + 2) = "ADET"
Excl.Range("C" & ş + 2) = "MARKASI"
Excl.Range("D" & ş + 2) = "BOYUT"
Excl.Range("E" & ş + 2) = "SERİ NO"
Excl.Range("F" & ş + 2) = "SORUŞTURMA NO"
Excl.Range("G" & ş + 2) = "TESLİM TARİHİ"
Excl.Range("H" & ş + 2) = "KULLANILMA TARİHİ"
Excl.Range("I" & ş + 2) = "KULLANAN PERSONEL"
Excl.Range("J" & ş + 2) = "KULLANILAN ŞAHIS"
Rs1.MoveNext
Loop
i = 1
Do Until Rs2.EOF
Excl.Sheets(SyfAdiTmp).Select
Excl.Cells(i + 3, "A") = Rs2(1)
i = i + 1
Rs2.MoveNext
Loop
Rs2.Close
DoCmd.RunMacro "Makro2" 'işlem bitince BİOS sesi Uyarı BİP
Excl.Visible = True
Set Excl = Nothing
DoCmd.SetWarnings True
End Sub
