16/10/2021, 20:33
userx
Private Sub Komut0_Click()
On Error Resume Next
DoCmd.SetWarnings False
Dim rs As Recordset
Dim rs2 As Recordset
Dim KTP As Excel.Workbook
Dim SYF As Excel.Worksheet
Set Excl = New Excel.Application
With Excl
.Application.Visible = True
.UserControl = True
End With
Excl.DisplayAlerts = False
Set KTP = Excl.Workbooks.Add
KTP.SaveAs (CurrentProject.Path & "\deneme3.xlsx")
Set rs2 = CurrentDb.OpenRecordset("Alinan_Malzeme_Giris")
Do Until rs2.EOF
SyfAdi = rs2(1) & " " & rs2(2)
SyfAdiTmp = SyfAdi
SyfNo = 0
Do While WorksheetExists(SyfAdiTmp, KTP) = True
SyfNo = SyfNo + 1
SyfAdiTmp = SyfAdi & IIf(SyfNo = 0, "", "(" & SyfNo & ")")
Loop
Excl.Sheets.Add.Name = SyfAdiTmp
Excl.Range("A1") = "Malzeme Adı": Excl.Range("B1") = "Seri No"
Excl.Range("C1") = "Miktar": Excl.Range("D1") = "ALINANID"
Me.Metin1 = rs2(0)
DoCmd.RunSQL ("SELECT Alinan_Malzeme_Giris.Malzeme_Adi, Tablo1.Malzeme_Seri_No, Alinan_Malzeme_Giris.Malzeme_Miktari, Tablo1.Alinan_ID" & vbCrLf & _
"INTO tbl_ExceleVer FROM Tablo1 LEFT JOIN Alinan_Malzeme_Giris ON Tablo1.Alinan_ID = Alinan_Malzeme_Giris.Alinan_ID " & vbCrLf & _
"WHERE (((Tablo1.Alinan_ID)=[Formlar]![Form1]![Metin1]));")
rs2.MoveNext
Set rs = CurrentDb.OpenRecordset("tbl_ExceleVer")
Do Until rs.EOF
Excl.Sheets(rs(0) & " " & rs(1)).Select
Excl.Range("A2").CopyFromRecordset rs
rs.MoveNext
Loop
rs.Close
Loop
rs2.Close
Excl.Visible = True
Set MyRecordset = Nothing
Set Excl = Nothing
Set KTP = Nothing
Set SYF = Nothing
Set rs = Nothing
Set rs2 = Nothing
DoCmd.SetWarnings True
On Error GoTo a
DoCmd.RunSQL "DROP table tbl_ExceleVer;"
rs.Close
a: Exit Sub
Exit Sub
End Sub
Sayın lemoncher2 çözüm bulmuşsun ama bu şekilde de dener misin?