Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
12/02/2019 07:29
Konu Sahibi
hegu
Yorumlar
10
Okunma
537
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
hegu

hegu

Aktif Üye
168
Hü.... Sı....
 54
 80
 579
 03/11/2008
23
 Konya
 Sağlık Memuru
 Ofis 2007
 18/07/2019,10:41
Sayın ozanakkaya hocam referans ekledim o kısımı hallettikten sonra ikinci hatayı verdi.




ozanakkaya

ozanakkaya

Kurucu
1
Oz.... Ak....
 39
 482
 12.116
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
 19/07/2019,20:59
Merhaba, toplam kısmındaki sorun için, kod içerisindeki

Visual Basic Code
Range("F4:G" & rs.RecordCount + 4 & "").NumberFormat = "#,##0.00 $"


kodunu iptal ederek deneyiniz.


"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

...........
hegu

hegu

Aktif Üye
168
Hü.... Sı....
 54
 80
 579
 03/11/2008
23
 Konya
 Sağlık Memuru
 Ofis 2007
 18/07/2019,10:41
ozanakkaya hocam özür dilerim ben size yanlış izah ettim. Alt taraftaki toplamı getirmiyor diyecektim. Yani her kurumun kendi genel toplamı.



ozanakkaya

ozanakkaya

Kurucu
1
Oz.... Ak....
 39
 482
 12.116
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
 19/07/2019,20:59

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Dim xlApp As Excel.Application
Dim xlSh, xlSh2, xlSh3, xlSh4 As Excel.Worksheet
Dim objWkb As Workbook
Dim GDosyaDizin As String
Dim rs, rsg As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim qdf As QueryDef
Dim GSayi As Integer
Dim GUyari As String
Dim SX As Integer
Dim SQL As String
Dim GGRup1, GGRup2, GGRup3 As String
Dim GToplam, GTopSayi As Integer


GDosyaDizin = CurrentProject.Path & "\Kurumlar_Excel.xlsx"

Set xlApp = New Excel.Application
SX = 0
xlApp.Visible = True
Set objWkb = xlApp.Workbooks.Add


SQL = "SELECT * FROM [srg_kurumlist] "
Set rsg = CurrentDb.OpenRecordset(SQL)

Do Until rsg.EOF = True
SX = SX + 1
    Set qdf = CurrentDb.QueryDefs("srg_hastalistesi")
    qdf![Forms!Izin_Raporu!DONEMI] = [Forms]![Izin_Raporu]![DONEMI]
    qdf![Forms!Izin_Raporu!UNVAN] = rsg![KURUM ADI]
     
    Set rs = qdf.OpenRecordset()
    
    intMaxCol = rs.Fields.Count
    
If rs.RecordCount = 0 Then

    GUyari = GUyari & rsg![KURUM ADI]
    
Else
      
    
     Set xlSh = objWkb.Sheets.Add
     xlSh.Name = Left(Replace(rsg![KURUM ADI], " ", "_"), 30)

        rs.MoveLast:    rs.MoveFirst
        intMaxRow = rs.RecordCount
            With xlSh
                .Range("A1").ColumnWidth = "6"
                .Range("B1").ColumnWidth = "18"
                .Range("C1").ColumnWidth = "35"
                .Range("D1").ColumnWidth = "15"
                .Range("E1").ColumnWidth = "15"
                .Range("F1").ColumnWidth = "17"
                .Range("G1").ColumnWidth = "16"
                .Range("A3") = "SIRA NO"
                .Range("B3") = "TC KİMLİK NO"
                .Range("C3") = "AD SOYAD"
                .Range("D3") = "MUAYENE TAR"
                .Range("E3") = "FATURA NO"
                .Range("F3") = "FATURA TAR"
                .Range("G3") = "TOPLAM"
                .Range("A3:G3").Select
                
                xlApp.Selection.Font.Bold = True
                xlApp.Selection.HorizontalAlignment = xlCenter
                xlApp.Selection.VerticalAlignment = xlCenter
                xlApp.Selection.Font.Bold = True
                xlApp.Selection.RowHeight = 50
                xlApp.Selection.WrapText = True
                
                .Range("A2:G2").Select
                
                .Range("A2") = rsg![KURUM ADI]
                
                xlApp.Selection.Font.Bold = True              
                xlApp.Selection.HorizontalAlignment = xlCenter
                xlApp.Selection.VerticalAlignment = xlCenter
                xlApp.Selection.Orientation = 0
                xlApp.Selection.ShrinkToFit = False
                xlApp.Selection.WrapText = True
                xlApp.Selection.MergeCells = True
                xlApp.Selection.RowHeight = 42
                
                .Range("B4").CopyFromRecordset rs            
                .Range("F4:G" & rs.RecordCount + 4 & "").NumberFormat = "#,##0.00 $" 
                .Range("F" & rs.RecordCount + 6 & "") = "TOPLAM"           
                .Range("B" & rs.RecordCount + 6 & "") = "Özet " & "'KURUM ADI' = " & rsg![KURUM ADI] & " (" & rs.RecordCount & " " & IIf(rs.RecordCount = 1, "ayrıntı kaydı", "ayrıntı kayıtlar") & ")"
                
                GToplam = 0
                
                For GTopSayi = 4 To rs.RecordCount + 4
                
                    GToplam = GToplam + .Range("G" & GTopSayi & "")
                
                Next GTopSayi
                
                .Range("G" & rs.RecordCount + 6 & "") = GToplam
                .Range("A1:G" & rs.RecordCount + 8 & "").Select
                
                xlApp.Selection.VerticalAlignment = xlCenter
                xlApp.Selection.HorizontalAlignment = xlCenter

                xlApp.Selection.Font.Name = "Arial"
                xlApp.Selection.Font.Size = 11
                
                .Range("C4:C" & rs.RecordCount + 4 & "").Select
                xlApp.Selection.HorizontalAlignment = xlLeft

                .Range("B" & rs.RecordCount + 6 & "").Select
                
                xlApp.Selection.HorizontalAlignment = xlLeft

                .Range("A3:G" & rs.RecordCount + 3 & "").Borders.Weight = xlThin
                
                For GSayi = 1 To intMaxRow
                .Range("A" & GSayi + 3) = GSayi
                Next
                
                .Range("A1").Select
                
        End With
      

        xlSh.PageSetup.Orientation = xlLandscape
        xlApp.PrintCommunication = False
        xlSh.PageSetup.FitToPagesWide = 1
        xlSh.PageSetup.FitToPagesTall = True
        xlApp.PrintCommunication = True
        

  End If
   

rsg.MoveNext
Loop
  
  
For Each xlSh In objWkb.Worksheets
	If InStr(1, xlSh.Name, "Sayfa") = 1 Then
		objWkb.Worksheets(xlSh.Name).Delete
	End If
Next xlSh
 
  

objWkb.SaveAs GDosyaDizin

Set xlSh = Nothing
Set xlApp = Nothing


If Len(GUyari) > 0 Then

MsgBox (GUyari & " Sayfası Veri Olmadığı İçin Oluşturulmadı")

End If


Excele aktarma ile ilgili yapabileceğim bundan ibaret.



"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

...........
hegu

hegu

Aktif Üye
168
Hü.... Sı....
 54
 80
 579
 03/11/2008
23
 Konya
 Sağlık Memuru
 Ofis 2007
 18/07/2019,10:41
Sayın ozanakkaya hocam emeğine sağlık. Teşekkür ederim.




Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Tablodan Forma Aktarma atamsinatamsin 19 479 09/07/2019, 18:24
Son Yorum: halily
Çözüldü Kayıt Silindiğinde Silinenler Tablosuna Aktarma haziran4 4 228 20/05/2019, 11:58
Son Yorum: haziran4
Çözüldü 3 Farklı Raporu Bir Pdf Te Toplamak aliyuzen 7 239 09/05/2019, 16:57
Son Yorum: aliyuzen
Çözüldü Access Formdaki Renkli Alanları Excele Renkli Olarak Aktarma IceMan7 6 469 10/04/2019, 15:27
Son Yorum: IceMan7
Çözüldü Mevcut Veri Tabanından Tek Bir Kayıt Raporu Nasıl Alırım ? Nihal Kocamaz Yazıcı 4 262 03/04/2019, 16:40
Son Yorum: Nihal Kocamaz Yazıcı

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