Pivot Tablo Hk.

Arkadaşlar merhaba pivot tablo ve grafik uygulamaları forma eklendiği zaman siline biliyor. Bu uygulamaları nasıl kilitleyebilirim?

(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.

Merhaba sayın biberli33 örnek doysa ekledim. Lashing-1 formunda 'lashing genel' de tablolar mevcut ve silinip değiştirilebiliyor.

Arkadaşlar fikri olan varmı acaba?

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

Bilgi için teşekürler ozan bey.