Pivot sorguyu Excel e pivot tablo olarak göndermek
Tarih
21/04/2009 14:16
Konu Sahibi
okileturc
Yorumlar
4
Okunma
2135
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy



okileturc
Aktif Üye
Kullanici Avatari
Aktif Üye
O.... V....
966
18/03/2009
459
İzmir
Ofis 2003
23/05/2016,13:38
Çözüldü 
Selamlar
Aktif olan bir Özet Tablo/Form u Excel e göndermek için

Kod:
DoCmd.RunCommand acCmdPivotTableExportToExcel

kullanıyorum, bir hata mesajına rağmen sonuç başarılı.
Ancak, kapalı olan bir Özet tablo sorgusunu
İsmini, adresini belirterek Excel' e pivot olarak vermek
istiyorum. Aşağıdaki kodu net te gördüm :

Kod:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Table1", "D:\Book1.xls", False, "Sheet1$"

Sanırım "DoCmd.RunCommand acCmdPivotTableExportToExcel" parametre
kabul etmediği için bu kod tercih edilmiş, ancak ben çalıştıramadım
Sonuç olarak :
Kapalı bir ÖzetTablo sorgusunu Excel' e pivot olarak nasıl gönderirim
Teşekkürler
resim

okileturc, 18-03-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla


Nika
Aktif Üye
Kullanici Avatari
Aktif Üye
69
16/04/2009
3
Ağrı
Ofis 2003
09/08/2010,02:10
Çözüldü 
[Kapalı bir ÖzetTablo sorgusunu ] dan kastinizi anlaymadim.
Sunumu demek istediniz; her hangi bir sorgunun bahse konu kodlar ile calistirilarak Pivot Table a aktarilmasindan mi bahsediyorsunuz?
Yoksa baska bi sey mi?
Cevapla


okileturc
Aktif Üye
Kullanici Avatari
Aktif Üye
O.... V....
966
18/03/2009
459
İzmir
Ofis 2003
23/05/2016,13:38
Çözüldü 
Herhangi bir sorguyu görünümden "Özet tablo görünümü"
olarak seçip design ettiğinizde, bu bilgiler saklanabiliyor ve ayni
sorguyu "özet tablo görünümünde" açarak
DoCmd.RunCommand acCmdPivotTableExportToExcel
komutuyla Excel e gönderdiğinizde sorgunun design bilgileriyle
(Bırakma alanları, satır, sütun, body, vs ) Excel e gidiyor. Yani Excel de
tekrardan pivot tablo düzenlemeleri yapmanıza gerek kalmıyor.
Benim problemim ( sorgu hidden-gizli ) olarak açılamadığı için
ya da ben öyle biliyorum, kapalı bir sorgunun ismini belirterek
export etmek

Oysa yukarıdaki kod sadece aktif olan sorguyu problemsiz atabiliyor

Not: İlk notuma bir resim ekledim. Bu örnek te görülen özet tablo
bir form ve aktif . Dolayısı ile yine yukarıdaki kod ile ayni design ı
excel e sorunsuz atıyor
okileturc, 18-03-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla


esrefigit

Kullanici Avatari
Onursal
598
30/10/2008
356
Konya
Ofis 2003
06/11/2015,13:38
Çözüldü 
bir sorgu yapın ona parametre belirtin ve onu export edebilrsin yada buna benzer bir kod uygularsın

Kod:
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
160
161
Function fProcErrs()

    On Error GoTo Proc_Err
    
    Dim booLeaveOpen As Boolean
    Dim wbkNew As Workbook
    Dim wksData As Worksheet
    Dim dbLocal As Database
    Dim snpErrors As DAO.Recordset
    Dim intCurrTask As Integer
    Dim rngCurr As Excel.Range
    Dim wksPivot As Worksheet
    Dim Cache As Excel.PivotCache
    Dim pTable As Excel.PivotTable
    Dim strSQL As String
    
    'if Excel is already open, use that instance
    booLeaveOpen = True
    
    'attempting to use something that is not available will
    'generate an error
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo Proc_Err
    
    'if xlApp is defined then we already have a conversation
    If TypeName(xlApp) = "Nothing" Then
        booLeaveOpen = False
        'Excel was not open - create new instance
        Set xlApp = CreateObject("Excel.Application")
    End If
    
    xlApp.Visible = True
    Set wbkNew = xlApp.Workbooks.Add
    Set wksData = wbkNew.ActiveSheet
    Set wksPivot = wbkNew.Sheets(2)
    wksPivot.Name = "Pivot"
    wksData.Name = "ProcErrors"
    
     Set dbLocal = CurrentDb()
    
    strSQL = "SELECT tbl_AuditTypes.AuditType, tbl_AuditData.AudDate, " & _
        "tbl_AuditData.ClaimNumber, tbl_PQuestData.QNotes, tbl_PQuestData.Qnum, " & _
        "tbl_Questions.Question, [BSFirstName] & ' ' & [BSLastName] AS Assignee, " & _
        "[AudFirstName] & ' ' & [AudLastName] AS Auditor, [MgrFirstName] & ' ' & [MgrLastName] AS Manager, " & _
        "tbl_Office.Office, [SupFirstName] & ' ' & [SupLastName] AS Supervisor, tbl_Training.Training " & _
        "FROM tbl_Auditors INNER JOIN (tbl_Office INNER JOIN (((tbl_ManagerID " & _
        "INNER JOIN tbl_Supervisor ON tbl_ManagerID.MgrID = tbl_Supervisor.MgrID) " & _
        "INNER JOIN tbl_Assignee ON tbl_Supervisor.SupID = tbl_Assignee.SupID) " & _
        "INNER JOIN ((tbl_AuditTypes INNER JOIN (tbl_AuditData INNER JOIN tbl_Training " & _
        "ON tbl_AuditData.TrnID = tbl_Training.TrnID) ON tbl_AuditTypes.AudTyID = " & _
        "tbl_AuditData.AudTyID) INNER JOIN (tbl_Questions INNER JOIN tbl_PQuestData " & _
        "ON tbl_Questions.QID = tbl_PQuestData.QID) ON tbl_AuditData.AuditID = " & _
        "tbl_PQuestData.AuditID) ON tbl_Assignee.AssignID = tbl_AuditData.AssignID) " & _
        "ON tbl_Office.OfficeID = tbl_Assignee.OfficeID) ON tbl_Auditors.AuditorID = " & _
        "tbl_AuditData.AuditorID " & _
        "WHERE (((tbl_AuditData.AudDate) Between #" & [Forms]![frm_ErrorRpts]![StartDate] & "# And" & _
        " #" & [Forms]![frm_ErrorRpts]![EndDate] & "#) " & _
        " AND((tbl_PQuestData.Response)=0));"
        
    'Debug.Print strSQL
    
    Set snpErrors = dbLocal.OpenRecordset(strSQL, dbOpenSnapshot)
            
    snpErrors.MoveLast
    snpErrors.MoveFirst
    
    Set rngCurr = wksData.Range(wksData.Cells(2, 1), _
        wksData.Cells(2 + snpErrors.RecordCount, 1))
          
    'populates new worksheet with data from qry_Errors
    rngCurr.CopyFromRecordset snpErrors

Resume430:
    
    'adds column headings and some formatting
    With wksData
      .Cells(1, 1).Value = "Audit Type"
      .Cells(1, 1).Font.Bold = True
      .Cells(1, 2).Value = "Audit Date"
      .Cells(1, 2).Font.Bold = True
      .Cells(1, 3).Value = "Claim Number"
      .Cells(1, 3).Font.Bold = True
      .Cells(1, 4).Value = "Comments"
      .Cells(1, 4).Font.Bold = True
      .Cells(1, 5).Value = "Question Number"
      .Cells(1, 5).Font.Bold = True
      .Cells(1, 6).Value = "Question"
      .Cells(1, 6).Font.Bold = True
      .Cells(1, 7).Value = "Assignee"
      .Cells(1, 7).Font.Bold = True
      .Cells(1, 8).Value = "Auditor"
      .Cells(1, 8).Font.Bold = True
      .Cells(1, 9).Value = "Manager"
      .Cells(1, 9).Font.Bold = True
      .Cells(1, 10).Value = "Office"
      .Cells(1, 10).Font.Bold = True
      .Cells(1, 11).Value = "Supervisor"
      .Cells(1, 11).Font.Bold = True
      .Cells(1, 12).Value = "Training"
      .Cells(1, 12).Font.Bold = True
      .Columns("A:L").AutoFit
      .Columns("A:L").WrapText = True
      .Columns("D").ColumnWidth = 50
      .Columns("F").ColumnWidth = 50
   End With
   
    Set Cache = xlApp.ActiveWorkbook.PivotCaches.Add( _
    xlDatabase, wksData.Name & "!R1C1:R" & snpErrors.RecordCount + 1 & "C12")
    
    Set pTable = Cache.CreatePivotTable(wksPivot.Cells(4, 1), "PivotTable1")
    
    wksPivot.Select
    
    Set wksPivot = wbkNew.ActiveSheet
    
    xlApp.ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
    
    'format pivot table

    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Audit Type")
        .Orientation = xlPageField
        .Position = 1
    End With
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Question")
        .Orientation = xlRowField
        .Position = 1
    End With
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Claim Number")
        .Orientation = xlDataField
        .Position = 1
    End With
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Claim Number")
        .Orientation = xlDataField
        .Position = 2
    End With
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Data")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Count of Claim Number2")
        .Calculation = xlPercentOfColumn
        .NumberFormat = "0%"
    End With
    With wksPivot
        .Columns("A").ColumnWidth = 50
    End With
        xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Audit Type").CurrentPage = _
        "Dental BS Audit"
    
Proc_Exit:
    On Error Resume Next
    
    If TypeName(xlApp) <> "Nothing" Then
        'xlApp.ActiveWorkbook.Close True
        'If Not booLeaveOpen Then xlApp.Quit
        Set xlApp = Nothing
    End If
    
    Exit Function

meşhur çin atasözü  "ACCESS İLE YAPABİLECEKLERİNİZ HAYAL EDEBİLECEKLERİNİZ İLE SINIRLIDIR" siz ne kadar hayal edebiliyorsunuz
Cevapla


ozanakkaya
sledgeab
Kullanici Avatari
Kurucu
O.... A....
9.030
29/01/2008
Denizli
Polis Memuru
Ofis 2010 32 Bit
Bugün,14:37
Çözüldü 
Konu, gereksiz mesajlar silinerek cevaplanmış sorular bölümüne taşınmıştır, kod için teşekkürler Eşref hocam.
Cevapla







Konuyu Okuyanlar: 1 Ziyaretçi


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Tarih Son Yorum
  Pdf olarak mail gönderme Serkan Çevik 8 177 04/12/2016, 15:17 Serkan Çevik
  Tablo dan Açılır Kutu ya alınan verilerek Sabit Ekleme yapma ask200075 7 269 21/11/2016, 18:49 ask200075
  Excel Formülleri hk. murat dikme 5 158 10/11/2016, 04:59 ozanakkaya
  Access Veritabanında Tablo Şifreleme ve Formdan Tabloya Bağlanma Nasıl Yapılır?? mehami 11 314 09/11/2016, 23:35 mehami
  SMS Göndermek Hakkında (Access 2007-2010) WiniFred 9 1.766 09/11/2016, 15:04 atoz112


Türkçe Çeviri: MCTR, Forum Yazılımı: MyBB, © 2002-2016 MyBB Group.
DMCA.com Protection Status
© Desing by XSTYLED| Develops by ozanakkaya