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...
__________________
Acil yardım lutfen! (excel application ile ilgili)
Programlama0 Mesaj
●22 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama
- Acil yardım lutfen! (excel application ile ilgili)