Arkadaşlar merhaba!
Yardımcı olursanız sevinirim!

Bir program yazıyorum. Bu programda data1 nesnem ve calışma dizininde daha once hazırladığım şablon bir excel calışma sayfam var (sertifika.xls isminde)
Ben data1 deki verileri b excel tablosuna atarak her parti nolu urun icin teker teker aktarma işlemini yapmak istedim ama olmadı. Boyle lunca bir dongu kurarak veri tabanı icindeki butun verileri bir defada atmayı denedim ve başarılı oldu.

İşin kotu yanı şu:
programıma tamamen son verdiğim zaman excel uygulaması hafızadan siliniyor. ama programı kapatmadan tekrar excele aktarma işlemini yaptığım zaman ise hata veriyor.

oluşturduğum bu excel objesini her aktar butonuna tıkladıktan ve işi bittikten sonra hafızadan nasıl atabilirim ki programı kapatmadan tekrar aktarma işlemini sorunsuz halledebileyim?

Son olarak her calıştırdığımda hata oluşuyor, hatayı gormemezlikten gel desem bile CTRL+ALT+DELETE tuşlarına bastığımda excel calışıyor gozukuyor.

Programın kodu aşağıda;


Private Sub Command1_Click()

Dim kitap As Object

Set kitap = CreateObject("excel.Application")

Data1.Recordset.MoveFirst

Do While Not Data1.Recordset.EOF

On Error GoTo hata

kitap.Workbooks.Open (App.Path & "\sertifika.xls")

ureticiadi = Data1.Recordset![u_firma_adi]
ureticiadresi = Data1.Recordset![u_firma_adresi]
ihracatciadi = Data1.Recordset![i_firma_adi]
ihracatciadresi = Data1.Recordset![i_firma_adresi]

kitap.Sheets("sayfa3").Range("d1").Value = Data1.Recordset![parti_no]
kitap.Sheets("sayfa3").Range("d2").Value = Data1.Recordset![urun_ingilizce_adi]

kitap.Sheets("sayfa3").Range("d3").Value = Data1.Recordset![ambalaj_tipi]
kitap.Sheets("sayfa3").Range("d4").Value = Data1.Recordset![ingilizce_aciklama1] & "-Brut:" & Data1.Recordset![brut] & " Net:" & Data1.Recordset![net]
kitap.Sheets("sayfa3").Range("d5").Value = "Hendek/SAKARYA"
kitap.Sheets("sayfa3").Range("d6").Value = Trim(Data1.Recordset![tasima_sekli])
kitap.Sheets("sayfa3").Range("d7").Value = Trim(Data1.Recordset![ihrac_ulke])
kitap.Sheets("sayfa3").Range("d8").Value = "Producer : " & Trim(ureticiadi) & " " & Trim(ureticiadresi)
kitap.Sheets("sayfa3").Range("d9").Value = "Exporter : " & Trim(ihracatciadi) & " " & Trim(ihracatciadresi)
kitap.Sheets("sayfa3").Range("d10").Value = Data1.Recordset![numune_alma_tarihi]
kitap.Sheets("sayfa3").Range("d11").Value = Data1.Recordset![analiz_tarihi]
kitap.Sheets("sayfa3").Range("d12").Value = " " & Data1.Recordset![laboratuvar]
'kitap.Sheets("sayfa3").Range("d13").Value = Data1.Recordset![sertifika_gecerlilik_tarihi]
kitap.Sheets("sayfa3").Range("d14").Value = Text22.Text
kitap.Sheets("sayfa3").Range("e18").Value = Data1.Recordset![sertifika_no]
kitap.Sheets("sayfa3").Range("e19").Value = Data1.Recordset![gtip_no]
kitap.Sheets("sayfa3").Range("e20").Value = Data1.Recordset![numune_alma_tarihi] & "-" & Data1.Recordset![numune_tutanak_no]
kitap.Sheets("sayfa3").Range("e21").Value = Data1.Recordset![analiz_tarihi] & "-" & Data1.Recordset![rapor_no]
kitap.Sheets("sayfa3").Range("e22").Value = Data1.Recordset![analiz_metodu]


' Sertifika gecerlilik tarihi yordamı başlangıcı

Dim sonkullanma As Date
sonkullanma = DateAdd("m", 4, Text22.Text)

'If Data1.Recordset![son_tuketim_tarihi] < Text22.Text Then
'MsgBox "son kullanım tarihi hatalı! Lutfen duzeltin..."
'GoTo hata
'End If

If Data1.Recordset![son_tuketim_tarihi] < sonkullanma Then
kitap.Sheets("sayfa3").Range("d13").Value = Data1.Recordset![son_tuketim_tarihi]
Else
kitap.Sheets("sayfa3").Range("d13").Value = sonkullanma
End If

' sertifika gecerlilik tarihi yazdırma bitişi



kitap.Sheets("sayfa3").Range("b25").Value = "Aflatoksin(B1)ppb Sample a " & Data1.Recordset![aflab1_1]

If Data1.Recordset![adlab1_2] "-" Then
kitap.Sheets("sayfa3").Range("b26").Value = " Sample b " & Data1.Recordset![adlab1_2]
Else
kitap.Sheets("sayfa3").Range("b26").Value = " "
End If

If Data1.Recordset![aflab1_3] "-" Then
kitap.Sheets("sayfa3").Range("b27").Value = " Sample c " & Data1.Recordset![aflab1_3]
Else
kitap.Sheets("sayfa3").Range("b27").Value = " "
End If


kitap.Sheets("sayfa3").Range("b30").Value = "(B1+B2+G1+G2)ppb Sample a " & Data1.Recordset![topafla_1]

If Data1.Recordset![topafla_2] "-" Then
kitap.Sheets("sayfa3").Range("b31").Value = " Sample b " & Data1.Recordset![topafla_2]
Else
kitap.Sheets("sayfa3").Range("b31").Value = " "
End If



If Data1.Recordset![topafla_3] "-" Then
kitap.Sheets("sayfa3").Range("b32").Value = " Sample b " & Data1.Recordset![topafla_3]
Else
kitap.Sheets("sayfa3").Range("b32").Value = " "
End If


ActiveWorkbook.SaveAs (App.Path & "\sertifikalar\" & Data1.Recordset![parti_no] & ".xls")



kitap.Workbooks(1).Close (True)
Data1.Recordset.MoveNext
Loop

kitap.Application.Quit
Set kitap = Nothing


hata:
MsgBox Error(Err)
If Not (kitap Is Nothing) Then
Set kitap = Nothing
End If

End Sub



Şimdiden değerli yardımlarınız icin teşekkurler...
__________________