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 Adlı Kullanıcıdan Alıntı: 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.


Visual Basic Code
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ı: 7)
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