Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
06/06/2014 12:38
Konu Sahibi
husem
Yorumlar
7
Okunma
2108
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
husem

husem

Aktif Üye*
4107
Hü.... Do....
 38
 32
 132
 08/03/2009
31
 Denizli
 Zabıt Katibi
 Ofis 2003
 14/03/2019,10:54
Çözüldü 
kusura bakmayın,
excele gönder butonunun
tıklandığında olayına,
aşağıdaki kodu kopyalamak yeterli.

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Dim dbSurucu As String
 Dim dbDosya As String
 Dim dbExcel As Object
 Dim fdExcel As Object
 Dim vbExcel As Object
 Dim vbBook As Object
 Dim vbSheet As Object
 
Dim rsExcel As New Recordset
 Set vbExcel = CreateObject("Excel.Application")
 Set vbBook = vbExcel.Workbooks.Add
 
SORGU = "SELECT SIPARIS_LISTESI.MUSTERI, PARTILENENLER.PARTI_NO, PARTILENENLER.IRS_KODU, SIPARIS_LISTESI.RENK_NO, SIPARIS_LISTESI.RENK, SIPARIS_LISTESI.CINSI, PARTILENENLER.PAR_KG, PARTILENENLER.MAK_NO, PARTILENENLER.DURUMU, PARTILENENLER.DURUM_ZAMANI FROM SIPARIS_LISTESI INNER JOIN PARTILENENLER ON SIPARIS_LISTESI.SIPARISNO = PARTILENENLER.SIPARIS_NO WHERE (((SIPARIS_LISTESI.MUSTERI)=[SIPARIS_LISTESI].[MUSTERI]) AND ((PARTILENENLER.PARTI_NO)=[PARTILENENLER].[PARTI_NO]) AND ((SIPARIS_LISTESI.RENK_NO)=[SIPARIS_LISTESI].[RENK_NO]) AND ((SIPARIS_LISTESI.CINSI)=[SIPARIS_LISTESI].[CINSI]) AND ((PARTILENENLER.DURUMU)='Sevk Edildi') AND ((PARTILENENLER.DURUM_ZAMANI)>=#5/16/2014# And (PARTILENENLER.DURUM_ZAMANI)<=#5/16/2014#));"
 
rsExcel.Open Me.Liste60.RowSource, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

 Set vbSheet = vbBook.Worksheets(1)
 
Dim fdArray, fdCount, rdCount
 fdCount = 0
 For Each fdExcel In rsExcel.Fields
 fdCount = fdCount + 1
 If fdCount > 1 Then
 fdArray = fdArray & "<,>" & fdExcel.Name
 Else
 fdArray = fdExcel.Name
 End If
 Next
 
' Excel Belgesine Başlıklar Aktarılıyor
 With vbSheet.Range("A1")
 .Resize(1, fdCount) = Split(fdArray, "<,>")
 .Resize(1, fdCount).Font.Color = &HFF0000
 End With
 
rdCount = 1
 While Not rsExcel.EOF
 rdCount = rdCount + 1
 fdCount = 0
 For Each fdExcel In rsExcel.Fields
 fdCount = fdCount + 1
 vbSheet.Cells(rdCount, fdCount) = fdExcel.Value
 Next
 
rsExcel.MoveNext
 'x:
 
Wend
 vbSheet.Cells.Select
 vbSheet.Cells.EntireColumn.AutoFit
 vbSheet.Range("A1").Select
 
'Excel Belgesi kaydediliyor.
 vbBook.SaveAs "Sipariş Stok Listesi " & Date & ".xls"
 vbExcel.Quit
 
Set dbExcel = Nothing
 Set rsExcel = Nothing
 Set vbExcel = Nothing
 Set vbBook = Nothing
 Set vbSheet = Nothing
 
MsgBox "Liste Belgelerim Klasörüne aktarılmıştır"



husem, proud to be a member of AccessTr.neT since 08-03-2009.

mmert06

mmert06

Aktif Üye
53713
me.... me....
 37
 63
 246
 01/05/2013
0
 Ankara
 mühendis
 Ofis 2010 32 Bit
 24/04/2019,01:02
sayın @husem bey paylaştığınız örneğe benzer bir çalışma yapmaya çalışıyorum fakat örneğinizi incelediğimde Compile Error: İnvalid Use of New keyword hatası veriyor. Nedeni nedir acaba?



...........

Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Access Formdaki Renkli Alanları Excele Renkli Olarak Aktarma IceMan7 6 429 10/04/2019, 15:27
Son Yorum: IceMan7
Çözüldü Mail Gönderirken Gövdeye Yazı Aralarına Resim Eklemek Ve Satır Ara Boşlukları zetyu 6 394 22/03/2019, 23:52
Son Yorum: zetyu
Çözüldü 2007 Raporu Excele Aktarma hegu 10 471 13/02/2019, 12:53
Son Yorum: hegu
Çözüldü Accesten Excele Aktarırken Hata mmert06 10 422 30/01/2019, 17:40
Son Yorum: mmert06
Çözüldü Whatsapp Link İle Mesaj Gönderirken Tüm Metin Değil İlk Kelime Gidiyor zetyu 3 449 18/12/2018, 22:20
Son Yorum: ates2014

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.