Da Word a Excel, creazione grafico accorpando date

[Gas75]

Ok, macro acquisita e funzionante.

Mi tengo tutto su Excel: ho formattato il foglio nel quale ho importato la tabella di Word ad hoc affinché siano praticamente uguali... ed è inutile avere doppioni.

Grazie di tutto!

[Gas75]

Non funziona più!
Ho dovuto inserire un evento in una data intermedia tra le ultime due, l'ho fatto con Inserisci riga... Ma ora il grafico è vuoto, ha solamente la scritta "Rilasciare qui i dati" dove dovrebbero esserci le barre diagrammate, e l'asse delle categorie contiene una serie di simboletti strani su più righe!

Dopo aver aggiornato l'elenco, ho salvato come sempre, e non riesco a tornare indietro...

[nicola75ss]

Hai ragione. Aggiungendo una riga nel mezzo va tutto a donnine.

Vedrò di trovare una soluzione. Spero.

[Gas75]

A saperlo, eviterò in futuro di ripetere l'errore... Ora vorrei ricostruire il diagramma... Si può?

[nicola75ss]

Associa al foglio che contiene le date questo codice

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ultima As Long
ultima = Range("A65536").End(xlUp).Row


Application.DisplayAlerts = False
Sheets("Grafico Pivot").Delete 'cancello il foglio relativo al grafico senza che mi appaiano messaggi di conferma
Application.DisplayAlerts = True

' verifico che le modifiche al foglio siano relative alla colonna A, quella che contiene le date
If Not Intersect(ActiveCell, Range("A:A")) Is Nothing Then

    If WorksheetFunction.CountA(Range("a1:a" & ultima)) = Range("A1:A" & ultima).Count Then
        Sheets("Foglio2").Cells.Clear 'cancello tutto il contenuto del foglio in cui andrà la tabella pivot
    
        Dim pt As PivotTable
        Dim xlworkbook As Excel.Workbook
        Dim WSD As Worksheet
        Set WSD = Worksheets("Foglio1") 'foglio che contiene le date
        Dim PTOutput As Worksheet
        Set PTOutput = Worksheets("Foglio2") 'foglio in cui creare la tabella pivot
        Dim PTCache As PivotCache
        Dim PRange As Range
        Dim ultimariga As Long
    
        ultimariga = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
        
        Set PRange = WSD.Cells(1, 1).Resize(ultimariga, 1)
        Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
    
        Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(1, 1), TableName:="Tabella Pivot")
           
        pt.ManualUpdate = True
    
        pt.AddFields RowFields:=Array("date")
       
        With pt.PivotFields("date")
            .Orientation = xlDataField
            .Function = xlCount
            .Position = 1
        End With


        pt.ManualUpdate = False


        Sheets("Foglio2").Select
        ActiveSheet.Range("A2").Select
        Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, True)

        Charts.Add
        With ActiveChart
            .SetSourceData Source:=Sheets("Foglio2").Range("A2")
            .Location Where:=xlLocationAsNewSheet
        End With
    
        With ActiveSheet
            .Name = "Grafico pivot" 'rinomino il grafico relativo alla tabella pivot
            .Move after:=Worksheets(Worksheets.Count) '... e lo sposto in coda a tutti gli altri fogli
        End With
    End If
End If
End Sub

Potrai anche rimuovere righe o aggiungere date tra quelle già esistenti avendo sempre la tabella pivot e il relativo grafico aggiornati.

[Gas75]

Ho copiato il codice in sostituzione del precedente, ma il grafico non s'è schiodato dalla situazione descritta stamane.

[nicola75ss]

Ricopia il contenuto del foglio con le date in un nuovo file e prova a riapplicare il codice. Con questa macro non serve la funzione scarto e quant'altro.

[Gas75]

No aspetta... Una cosa vorrei capire prima...
Nel file ho copiato il tuo codice in sostituzione al precedente, ho salvato il file ottenendo il nulla come risultato... Ora che ho riaperto il file per copiare l'elenco... il codice si è cancellato!
Come la dovevo cliccare l'icona Salva? A pugni sul monitor?

Intanto facendo come dici non risolvo nulla, perché oltre alla lista credo avrei da definire tutta la tabella pivot!
Posso recuperare il file precedente? Sennò riprendo a gestire la lista su Word e i grafici me li faccio a mano, almeno smetto di avere a che fare con salvataggi che cancellano i codici!

[nicola75ss]

http://myfreefilehosting.com/f/5fd541389d_0.04MB