tabella pivot

Hai un problema con Excel?

Nuova discussione

tabella pivot
di rick85 (utente non iscritto) data: 28/01/2015 15:58:14

salve a tutti!!!

ho veramente bisogno del vostro aiuto.
devo creare una pivot con un determinato format in maniera automatica tramite codice vba.
ho trovato dei codici cheperò non riesco ad interpretare.
in poche parole devo creare una macro che mi apre un file excel con dei dati e con quei dati costruire una pivot
vi allego due file in uno c'è un esempio della pivot che sto cercando di tirar fuori con la macro e nell'altro il file che contiene i dati e che apro all'esecuzione della macro
ho trovato un codice che a quanto ho letto ha creato scossa ma non riesco ad adattarlo
se riusciste ad aiutarmi adattandolo alla mia situazione ve ne sarei grato

Sub WorksheetLoop()
    Dim bEvents As Boolean
    Dim bAlerts As Boolean
    Dim CalcMode As Long
    Dim bScreen As Boolean
     
    ' save current settings
    bEvents = Application.EnableEvents
    bAlerts = Application.DisplayAlerts
    CalcMode = Application.Calculation
    bScreen = Application.ScreenUpdating
     
    ' disable events, alerts, automatic calculation & screen updating
    With Application
        .EnableEvents = False
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
    FileToOpen = Application.GetOpenFilename _
    (Title:="Seleziona un file da importare", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    
    If FileToOpen = False Then
        MsgBox "Non è stato selezionato alcun file", vbExclamation, "Doh!!!"
    Exit Sub
    Else
        Workbooks.Open Filename:=FileToOpen
    End If
    
    tmpBoolean = Pivot()
    
    With Application
        .EnableEvents = bEvents
        .DisplayAlerts = bAlerts
        .Calculation = CalcMode
        .ScreenUpdating = bScreen
    End With
     
     
     MsgBox ("Procedura terminata")
End Sub



Function Pivot()
  
  Dim wsDati As Worksheet, wsPivotta As Worksheet
  Dim oPvtCch As PivotCache
  Dim oPvtTbl As PivotTable
  Dim ptField As PivotField
  Dim rngDati As Range
  Dim r As Long

  Set wsDati = ActiveWorkbook.Worksheets("Riepilogo Righe")
  r = wsDati.Cells(Rows.Count, 1).End(xlUp).Row    'occhio al riferimento di colonna
  Set rngDati = wsDati.Range("A1:Y" & r)    'prendo gli stessi dati utilizzati nel foglio "Pivotta"
  Set oPvtCch = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngDati)   'crea cache per tabella dal range
  Set oPvtTbl = oPvtCch.CreatePivotTable(wsPivotta.Cells(7, 2))   'crea pivot in nuovo foglio

  With oPvtTbl
    .RowAxisLayout xlOutlineRow
    .Name = "Pivotta_VBA"
    .PivotFields(6).Orientation = xlColumnField    'campo13, tredicesima colonna "Ufficio" etichetta di riga
    .PivotFields(6).Position = 1    'primo elemento di riga
    .PivotFields(13).Orientation = xlColumnField    ' campo 3 "Sesso" etichetta di riga
    .PivotFields(13).Position = 2    'secondo elemento di riga
    .PivotFields(16).Orientation = xlColumnField    ' campo 14 "Capo Ufficio" etichetta di colonna
    .PivotFields(16).Position = 1    ' primo elemento di colonna
    .PivotFields(18).Orientation = xlColumnField    ' campo 14 "Capo Ufficio" etichetta di colonna
    .PivotFields(18).Position = 1    ' primo elemento di colonna
    .PivotFields(19).Orientation = xlColumnField    ' campo 14 "Capo Ufficio" etichetta di colonna
    .PivotFields(19).Position = 1    ' primo elemento di colonna
    .PivotFields(20).Orientation = xlColumnField    ' campo 14 "Capo Ufficio" etichetta di colonna
    .PivotFields(20).Position = 1    ' primo elemento di colonna
    
    '.PivotFields(6).Orientation = xlPageField    'campo 6 "Tipo di contratto" filtro rapporto
    '.PivotFields(6).Position = 1
    '.AddDataField .PivotFields(1), "N. Dipendenti", xlCount    'contegigo dei nomi dipendenti (campo 1)
    '.AddDataField .PivotFields(7), "Stipendio Medio", xlAverage    'Media del campo stipendio
    '.PivotFields("Stipendio Medio").NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"    'formatto stipendio
    '.TableStyle2 = ""    'formatto la tabella in modo identico a quella creata manualmente
    For Each ptField In .RowFields    'elimino i subtotali
      On Error Resume Next
      ptField.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Next ptField
  End With
  'wsPivotta.Cells(11, 4).ShowDetail = True 'PER CREARE FOGLIO CON DETTAGLIO POSIZIONI
  Set wb = Nothing
  Set wsDati = Nothing
  Set wsPivotta = Nothing
  Set rngDati = Nothing
  Set oPvtCch = Nothing
  Set oPvtTbl = Nothing
End Function

Impossibile leggere il record
di Sbizzy (utente non iscritto) data: 28/01/2015 16:29:34
Ciao a tutti,

ho una macro con il codice che vedete sotto (ho solo nascosto gli indirizzi dei file) che banalmente copia il contenuto di un file sul mio pc (il file sorgente) e lo copia in un file condiviso in rete (file target).
Premettendo che il file condiviso è sicuramente inutilizzato dalla rete al momento dell'avvio della macro, ogni tot volte che la macro viene avviata (credo siano circa 20) mi segnala un errore che dice: "Impossibile leggere il record 943. Continua a segnalare errore?" Cliccando su SI, mi segnala un'altro record e cosi via, cliccando su NO mi chiede di salvare il file target come SYLK (non so cosa sia). L'unica soluzione è interrompere la macro, eliminare il file target e sostituirlo con una copia rinominata del file sorgente.

Qualche idea del perchè succeda questo?

ps: In allegato file di esempio del file sorgente e target.

Sub AGGIORNA()

Application.ScreenUpdating = False

    Workbooks.Open Filename:= _
        "C:..........FILE SORGENTE.SLK"
    Cells.Select
    Selection.Copy
    Workbooks.Open Filename:= _
        "Z:.......FILE TARGET.SLK"
    Cells.Select
    ActiveSheet.Paste
    ActiveWindow.Close (True)
    Windows("FILE SORGENTE.SLK").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close (False)
    
Application.ScreenUpdating = True
    
End Sub

Vuoi Approfondire?