Skip to main content

AccessTr.neT


Pivot Tablo Hk.

Pivot Tablo Hk.

Çözüldü #1
Arkadaşlar merhaba pivot tablo ve grafik uygulamaları forma eklendiği zaman siline biliyor. Bu uygulamaları nasıl kilitleyebilirim?
Cevapla
#2
(01/07/2017, 18:11)serkan1985 yazdı: Arkadaşlar merhaba pivot tablo ve grafik uygulamaları forma eklendiği zaman siline biliyor. Bu uygulamaları nasıl kilitleyebilirim?

Sayın Serkan, normalde eklediğiniz özet tablo ve grafiklerin silinmemesi gerekir. Siz ana tabloya veri girdikçe verileri görmek için özet tabloyu yenilemeniz yeterli. Eğer ana tabloyu silmiyor sanız özet tabloya bir şey olmaması gerekir.Örnek dosya ya da ekran görüntüsü varsa atar mısınız. Kolay gelsin.
Vatanını en çok seven, görevini en iyi yapandır!!!
Son Düzenleme: 02/07/2017, 14:54, Düzenleyen: biberli33.
Cevapla
#3
Merhaba sayın biberli33 örnek doysa ekledim. Lashing-1 formunda 'lashing genel' de tablolar mevcut ve silinip değiştirilebiliyor.
.rar lashing.rar (Dosya Boyutu: 312,33 KB | İndirme Sayısı: 12)
Cevapla
#4
Arkadaşlar fikri olan varmı acaba?
Cevapla
#5
Merhaba,
PivotTable görünümündeki formu kilitleyemezsin.

Bunun yerine, pivot tabloyu excele aktarır, oluşturulan exceli formda ilişkisiz nesne çerçevesinde gösterebilirsin.


Private Sub Form_Current()
On Error Resume Next
Call ExcelYenile
With Me![OLEİlişkisiz14]
.Locked = False
.Enabled = True

.Class = "Microsoft Excel 12"

.OLETypeAllowed = acOLELink

.SourceDoc = CurrentProject.Path & "\lashing.xlsx"

.SourceItem = ""

.Action = acOLECreateLink

.SizeMode = acOLESizeZoom

End With

End Sub


Private Sub ExcelYenile()

   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 = CreateObject("Excel.Application")
   
   
   '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 = False
   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 Kimlik, Yıl, Ay, End_Time, Event_Type, Lashing_Type, Equip_ID, ISO_Length, Quantity, Line_ID FROM Lashing;"
       
   '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 = "Kimlik"
     .Cells(1, 1).Font.Bold = True
     .Cells(1, 2).Value = "Yıl"
     .Cells(1, 2).Font.Bold = True
     .Cells(1, 3).Value = "Ay"
     .Cells(1, 3).Font.Bold = True
     .Cells(1, 4).Value = "End_Time"
     .Cells(1, 4).Font.Bold = True
     .Cells(1, 5).Value = "Event_Type"
     .Cells(1, 5).Font.Bold = True
     .Cells(1, 6).Value = "Lashing_Type"
     .Cells(1, 6).Font.Bold = True
     .Cells(1, 7).Value = "Equip_ID"
     .Cells(1, 7).Font.Bold = True
     .Cells(1, 8).Value = "ISO_Length"
     .Cells(1, 8).Font.Bold = True
     .Cells(1, 9).Value = "Quantity"
     .Cells(1, 9).Font.Bold = True
     .Cells(1, 10).Value = "Line"
     .Cells(1, 10).Font.Bold = True
     .Cells(1, 11).Value = "-"
     .Cells(1, 11).Font.Bold = True
     .Cells(1, 12).Value = "-"
     .Cells(1, 12).Font.Bold = True
     .Columns("A:J").AutoFit
     .Columns("A:J").WrapText = True

  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
   

   With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Event_Type")
       .Orientation = xlRowField
       .Position = 1
   End With
   
   
   
   With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Quantity")
       .Orientation = xlDataField
       .Position = 1
   End With
   With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Quantity")
       .Orientation = xlDataField
       .Position = 2
   End With
   
       With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Line")
       .Orientation = xlColumnField
       .Position = 1
   End With
   
   With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields("Data")
       .Orientation = xlColumnField
       .Position = 2
   End With
   With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields( _
       "Toplam Quantity2")
       .Calculation = xlPercentOfColumn
       .NumberFormat = "0%"
   End With
   
    With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields( _
       "Toplam Quantity2")
       .Name = "Yüzde"
   End With
   
        With xlApp.ActiveSheet.PivotTables("PivotTable1").PivotFields( _
       "Toplam Quantity")
       .Name = "Toplam"
   End With
   
   With wksPivot
       .Columns("A").ColumnWidth = 50
   End With

xlApp.ActiveWorkbook.SaveAs FileName:=CurrentProject.Path & "\lashing.xlsx"

xlApp.ActiveWorkbook.Close True
xlApp.Quit

   
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 Sub
End Sub

.rar lashing_sld.rar (Dosya Boyutu: 328,78 KB | İndirme Sayısı: 8)
Cevapla
#6
Bilgi için teşekürler ozan bey. +rep +rep
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task