Macro per modifica grafici

Hai un problema con Excel?

Nuova discussione

Macro per modifica grafici
di Vespa130 (utente non iscritto) data: 17/11/2016 08:15:23
Buon giorno,
devo fare una macro su Excel in maniera che eseguendola all'interno di un grafico già compilato o vuoto, vada a prendere le informazioni su 3 celle, le quali a sua volta contengono i riferimenti con delle righe presenti su un altro foglio (che contengono i valori per la compilazione delle serie).
Ho necessità di fare questo, perché ho 400 grafici da aggiornare, i quali vengono ripetuti consecutivamente ad una distanza fissa, prendendo i valori anche questi su 400 tabelle ripetute ciclicamente a distanza fissa.
Io ho creato un semplice codice e funziona ma non egregiamente.
Qualcuno mi sa dare delle maggiori info o qualche altra strada?

Guardando il codice VBA che vi allego, praticamente con il comando "ActiveChart.SetSourceData Source" vado sulle celle A1 - B1 - C1 le quali contengono rispettivamente i riferimenti con scritto:
Foglio1
Foglio1!A2:A4
Foglio1!E2:E4

Grazie mille per la disponibilità

Sub Modifica_grafico()
'
' Modifica_grafico Macro
'
' Scelta rapida da tastiera: CTRL+MAIUSC+Z
'    ActiveSheet.ChartObjects("Grafico 2").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.SetSourceData Source:=Sheets(Range("A1").Value).Range(Range("B1").Value & ":" & Range("C1").Value), PlotBy _
        :=xlColumns
End Sub

di patel data: 17/11/2016 08:41:48
allega un file di esempio

aggiornamento
di Vespa130 (utente non iscritto) data: 17/11/2016 11:30:56
Ecco ti allego un semplice file Excel. Sono riuscito a migliorarlo, modificando leggermente il codice VBA per adattarlo alla mia esigenza.
Così funziona, però vorrei automatizzarlo maggiormente, nel senso che ho molti blocchi di dati in sequenza comprensivi di grafici, e vorrei che ogni volta che eseguo la macro sopra un grafico, si aggiorni con i relativi dati.
Praticamente, nel file che ho allegato, vorrei che nel foglio 2 le celle B1, C1 e B20, C20 (e così via per tutte quelle che si ripetono successivamente), prendessero in automatico le informazioni dal foglio 1 (ci vorrebbe qualcosa tipo =Foglio1!B21:O21 però questo non funziona). Inoltre, la stessa macro lanciata nel grafico 1 e che vado ad eseguire nel secondo grafico, dovrebbe in automatico andare a prendere i riferimenti dalle celle B20 e C20 (e non più B1 e C1).

Grazie

Sub Modifica_grafico()
'
' Modifica_grafico Macro
'
' Scelta rapida da tastiera: CTRL+MAIUSC+Z
'    ActiveSheet.ChartObjects("Grafico 2").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.SetSourceData Source:=Sheets(Range("A1").Value).Range(Range("B20").Value & "," & Range("C20").Value), PlotBy _
        :=xlRows
End Sub

di Marius44 data: 18/11/2016 10:59:37
Ciao
Ti allego il tuo file in cui ho aggiunto due fogli (per non inficiare il tuo lavoro).

Il Foglio3 ripete il tuo Foglio1 ma con i dati più ravvicinati (non è necessario ma più comodo se le righe fra i due non sono utili).

Il Foglio4 ha delle macro:
una viene lanciata all'attivazione del Foglio ed esegue la copia della col.A di Foglio3 per assumere SOLO il titolo del Grafico col numero (che ho aggiunto) il cui elenco viene assegnato alla cella A2 come Validation;
l'altra si attiva alla selezione del grafico desiderato mostrandolo sotto il blocco delle righe.
La freccia è per scrollare verso l'alto il foglio4.

Prova e fai sapere. Ciao,
Mario
file modificato
di Vespa130 (utente non iscritto) data: 18/11/2016 11:51:30
Ciao Mario,
ho scaricato il file ma è uguale al mio iniziale. Puoi controllare?

Grazie
Mirco
di Marius44 data: 18/11/2016 18:42:41
Ciao
Hai ragione. Nella fretta (stavo per uscire con mia moglie) ho allegato il file sbagliato.
Rimedio subito e scusa.
Ciao,
Mario
Chiarimenti
di Vespa130 (utente non iscritto) data: 21/11/2016 09:55:56
Ciao Mario, non ti preoccupare.
Ho aperto il file corretto. I dati distanziati mi servono perché in realtà ne ho altri nel mezzo ed avevo semplificato il file, mantenendo però il layout per vedere appunto se con la macro riuscivo agilmente a ripetere i collegamenti dei grafici con i dati.
Ok per i nomi dei grafici. Non capisco la macro che dici si attivi alla selezione del grafico desiderato mostrandolo sotto il blocco delle righe.
Tra l'altro guardando le macro, io vedo solo quella del comando TORNA SU e poi quella che avevo creata io, non ne vedo altre (nemmeno quelle che dici create nel foglio 4).
Forse mi sono spiegato male, io ho necessità di creare nuovi o aggiornare molti grafici, i cui dati vengono presi appunti da righe a distanza costante.
Io voglio evitare di dover andare a creare un nuovo grafico o aggiornarlo, facendo poi SELEZIONA DATI --> andare sull'altro foglio, cercare i dati successivi a quello precedente e confermare.
Vorrei che con una macro unica scritta con un contatore all'interno possa fare tutto automaticamente (il contatore servirebbe per dire al grafico n°... creato nuovo o aggiornato di prendere i valori alle righe x,y).
Non so se possa essere fattibile una macro dove da una matrice di valori, poi basta dare per ogni grafico a che righe andare a prendere i valori necessari per il grafico.
Inoltre ho visto che i grafici che hai creato non sono corretti perché i valori delle X non sono sempre corretti.
E' possibile trovare una soluzione al mio caso? allego file originale dove ho l'esigenza della macro (ho ridotto a 10 i blocchi, ma ne ho molti di più), dove nel foglio CURVE OUTPUT i grafici rappresentato sia i valori estrapolati sia quelli del foglio stesso ricalcolati per vedere che non siano sbagliate.

Grazie,
Mirco

di Marius44 data: 22/11/2016 12:13:40
Ciao
Ho provato a realizzare quanto da te chiesto.
Ti allego il File "Crea_Grafici". Vedi se può andar bene per le tue esigenze (basta cliccare sul pulsante). Ho utilizzato la macro che indico sotto (ma senza il file non è facile capire come funziona).

Fai sapere. Ciao,
Mario

Option Explicit

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart()
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then
        ReDim Preserve nomichart(1 To ws.Shapes.Count)
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then nomichart(i) = oChar.Name
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If IsEmpty(nomichart) Then
            For k = 1 To UBound(nomichart)                              'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(i) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        'altrimenti creo i 4 grafici
        'a = a + 1
        valoreX = "Foglio1!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select

            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
            End With
            'posizione
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 230
            End With
            nm = ""
        Next k
2    Next i
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

Ottima macro
di Vespa130 (utente non iscritto) data: 25/11/2016 09:38:11
Ciao Mario,
intanto grazie mille!!! ho guardato il file che mi hai allegato e lanciato la macro e funziona !!
Ho provato anche a decifrare il codice VBA e l'ho compreso abbastanza .
Volevo però chiederti un paio di cose sul funzionamento. Il primo grafico, è l'unico che riporta all'interno non solo la prima riga delle Y, ma anche le altre 3 e non capisco come mai (ti allego un'immagine). Poi se vengono inseriti dati in un secondo momento, cioè dopo aver lanciato la macro e creato i grafici, sul nome della serie viene riporta una stringa che è sempre quella precedente a quella delle Y. Se si guarda invece i riferimenti del grafico prima di inserire i dati nella tabella, nel nome serie non è selezionata alcuna riga (ti allego un'immagine). Ho visto però che non succede su tutti i grafici.

Inoltre, sarebbe possibile fare un'ulteriore upgrade alla macro e fare in modo che nella creazione dei grafici, vada a prendere altri dati su un altro foglio (che sarebbero i dati originali)? Questo per mettere a confronto 2 curve su uno stesso grafico.

Oppure, se possibile, creare prima tutti i grafici e in un secondo momento lanciare un'altra macro che inserisca i dati presi dal foglio 1 e dal foglio 2.

Ti allego il file con il foglio aggiuntivo.
Grazie mille per la disponibilità, finora sei stato molto utile.

Ciao
Mirco

di Marius44 data: 25/11/2016 18:39:31
Ciao Mirco
Ho dato una "ripassata" alla macro. Ovviamente non è perfetta ma qualche miglioramento si vede (se NON c'è alcun grafico la macro li crea per quelle pompe in cui ci sono valori; se un grafico è già presente non lo crea di nuovo).
Ho aggiunto, ma solo per la prima pompa e da utilizzare DOPO aver creato il grafico, un'altra macro che aggiunge la nuova curva relativa ai dati presenti nel foglio2.

Sotto entrambi i codici.
Vedi se può andare (al caso rivediamo passo dopo passo e senza fretta )
Fai sapere. Ciao,
Mario

Option Explicit

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart(), a As Integer, j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then
        ReDim Preserve nomichart(1 To ws.Shapes.Count)
        a = 1
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then nomichart(a) = oChar.Name: a = a + 1
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If ws.Shapes.Count > 0 Then
            For k = 1 To UBound(nomichart)                               'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(k) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        If Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
        'altrimenti crea i 4 grafici
        valoreX = "Foglio1!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
            End With
            'posizione
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 230
            End With
            nm = ""
        Next k
2   Next i
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

Sub AggiungiPompa1A()
Dim oChar As Shape
Dim wb As Workbook, ws As Worksheet
Dim valoreX As String, valoreY As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
For Each oChar In ActiveSheet.Shapes
    valoreX = "Foglio1!$E$" & 5 & ":$V$" & 5
    valoreY = "Foglio2!$E$" & 5 + 1 & ":$V$" & 5 + 1
    If oChar.Name = "Pompa 1A" Then
        oChar.Chart.SeriesCollection.Add Source:=valoreY
    End If
Next
Set wb = Nothing
Set ws = Nothing
End Sub

di Vespa130 (utente non iscritto) data: 29/11/2016 15:48:29
Ciao Mario, ti ringrazio per la pazienza .

Ho visto i miglioramenti della macro, sia sui grafici che non vengono creati nel caso non siano presenti i dati, sia sull’inserimento di diversi indici per non creare confusione tra le varie istruzioni.
Ho visto anche la macro per l’aggiunta di una nuova curva relativa al foglio 2. Ho provato ad aggiungere degli indici per continuare con l’aggiunta delle altre serie di dati sugli altri grafici ma non sono riuscito (vorrei capire come posso fare).
Ho provato quindi ad inserirla anche nella macro precedente, mentre vengono creati i grafici, riportando i riferimenti al foglio 2 e aggiungendo “oChar.Chart.SeriesCollection.Add Source:=valoreY2”.
Mi funziona per il primo grafico mentre nei successivi non funziona bene, questo perché riseco solo a selezionare i valore delle Y mentre i valori delle X tiene sempre quelli dati precedentemente e non capisco il motivo. Avevo provato ad aggiungere anche “oChar.Chart.SeriesCollection.Add Source:=valoreX2” ma crea un’altra serie dati mantenendo sempre i valori delle X selezionati la prima volta (ti allego parte del codice cambiato, ma mi viene da pensare che il comando impartito non sia corretto).
Inoltre c’è sempre il primo grafico che riporta le curve di tutto il blocco dati delle Y, come se quando viene creato il grafico all’inizio (tramite “Set oChar = ws.Shapes.AddChart”) prendesse in automatico tutte le curve che excel propone in automatico.
Attendo con pazienza una tua gentile risposta .

Buona giornata,
Mirco

.....
valoreX = "Foglio1!$E$" & i & ":$V$" & i
valoreX2 = "Foglio2!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            valoreY2 = "Foglio2!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                oChar.Chart.SeriesCollection.Add Source:=valoreY2
                .Legend.Delete
            End With
.....

di Marius44 data: 30/11/2016 11:16:12
Ciao Mirco
sotto ti posto il nuovo codice. Credo che faccia quello che ti serve.
Non son riuscito a capire, e tanto meno a togliere, perchè mette tutte le serie nel primo grafico. Proverò ancora.
Ti ho aggiunto un pulsante (per le tue doverose prove) che elimina tutti i grafici. Dopo andrà eliminato lui stesso.
Dimmi che te ne pare.
Ciao,
Mario

PS il file nuovo porta il numero Tre

Option Explicit

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart(), a As Integer, j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then
        ReDim Preserve nomichart(1 To ws.Shapes.Count)
        a = 1
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then nomichart(a) = oChar.Name: a = a + 1
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If ws.Shapes.Count > 0 Then
            For k = 1 To UBound(nomichart)                               'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(k) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        If Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
        'altrimenti crea i 4 grafici
        valoreX = "Foglio1!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            'Stop
            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
            End With
            'posizione
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 230
            End With
            nm = ""
        Next k
        'controlla se vi sono dati in Foglio2 e, in caso positivo, aggiunge le serie
        With Worksheets(2)
            If .Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
            'altrimenti
            For k = 1 To 4
                If k = 1 Then ltr = "A"
                If k = 2 Then ltr = "B"
                If k = 3 Then ltr = "C"
                If k = 4 Then ltr = "D"
                nm = .Cells(i, 1) & ltr
                oChar.Name = nm
                valoreY = "Foglio2!$E$" & i + k & ":$V$" & i + k
                ActiveSheet.ChartObjects(nm).Activate
                ActiveChart.SeriesCollection.Add Source:=valoreY
            Next k
        End With
        valoreX = "": valoreY = ""
2   Next i
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

Sub eliminagrafici()
Dim oChar As Shape
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then oChar.Delete
        Next
End Sub

di Vespa130 (utente non iscritto) data: 02/12/2016 09:59:47
Ciao Mario, ormai ci siamo e sta uscendo una bella macro .
Manca solo da affinare qualcosina. Ottima anche la macro di elimina grafici .
Ho provato a metterci le mani. Non sono ancora riuscito a risolvere il discorso che nel primo grafico vengano messe tutte le serie del primo gruppo dati (però pazienza, per un grafico direi che lo posso anche sistemare poi a mano .
Ho poi provato ad aggiungere qualche blocco in più nel foglio 2 e utilizzando la tua macro, praticamente quando va ad aggiungere le serie sui grafici già fatti, li continua ad inserire solo sui primi 4 grafici, senza passare ai successivi.

Una cosa che invece sono riuscito a sistemare, è che nell'aggiunta delle serie sui grafici già fatti, vada a prendere sia i valori delle X che delle Y dal foglio 2 e non le X dal foglio 1(però rimane lo stesso mal funzionamento di prima, dove stavolta inserisce tutte le serie su sullo stesso quarto grafico).

Inoltre, da quando ho aggiunto più blocchi di dati nel foglio 2, quando vado ad eliminare i grafici non capisco come mai li cancella tutti a parte il quarto ti tutti i blocchi.

Grazie per la pazienza.

Mirco

....
        With Worksheets(2)
            If .Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
            'altrimenti
            valoreX = "Foglio2!$E$" & i & ":$V$" & i
            For k = 1 To 4
                If k = 1 Then ltr = "A"
                If k = 2 Then ltr = "B"
                If k = 3 Then ltr = "C"
                If k = 4 Then ltr = "D"
                nm = .Cells(i, 1) & ltr
                oChar.Name = nm
                valoreY = "Foglio2!$E$" & i + k & ":$V$" & i + k
                ActiveSheet.ChartObjects(nm).Activate
                ActiveChart.SeriesCollection.NewSeries
                ActiveChart.SeriesCollection(2).Values = valoreY
                ActiveChart.SeriesCollection(2).XValues = valoreX
            Next k
        End With
        valoreX = "": valoreY = ""
.......

di Marius44 data: 02/12/2016 16:34:52
Ciao Mirco
vedrai che passo dopo passo arriveremo alla soluzione.
Intanto complimenti per aver "sistemato" la sorgente X per il Foglio2. Bravo.

Dunque.
Li scrive sempre nella stessa riga per una mia svista. Occorre dirgli la posizione, cioè bisogna riportare tutto quello che si riferisce a posV e posO come per Foglio1. Vedi la macro aggiornata sotto.

Per quanto attiene l'eliminazione dei grafici a me li elimina tutti.
In merito al problema del primo grafico ancora non ho risolto.

Fai sapere. Ciao,
Mario

Option Explicit

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart(), a As Integer, j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then
        ReDim Preserve nomichart(1 To ws.Shapes.Count)
        a = 1
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then nomichart(a) = oChar.Name: a = a + 1
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If ws.Shapes.Count > 0 Then
            For k = 1 To UBound(nomichart)                               'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(k) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        If Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
        'altrimenti crea i 4 grafici
        valoreX = "Foglio1!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            'Stop
            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
            End With
            'posizione
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 230
            End With
            nm = ""
        Next k
'controlla se vi sono dati in Foglio2 e, in caso positivo, aggiunge le serie
        With Worksheets(2)
            If .Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
            'altrimenti
            valoreX = "Foglio2!$E$" & i & ":$V$" & i
            For k = 1 To 4
                If k = 1 Then ltr = "A": posO = 30
                If k = 2 Then ltr = "B": posO = 305
                If k = 3 Then ltr = "C": posO = 580
                If k = 4 Then ltr = "D": posO = 855
                nm = .Cells(i, 1) & ltr
                oChar.Name = nm
                valoreY = "Foglio2!$E$" & i + k & ":$V$" & i + k
                ActiveSheet.ChartObjects(nm).Activate
                ActiveChart.SeriesCollection.Add Source:=valoreY            'posizione
                posV = Cells(i + 5, 2).Top + 10
                With ActiveSheet.ChartObjects(nm)
                    .Left = posO
                    .Top = posV
                End With
                nm = ""
            Next k
        End With
        valoreX = "": valoreY = ""
2   Next i
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

di Marius44 data: 03/12/2016 08:21:29
Ciao Mirco
vedrai che passo dopo passo arriveremo alla soluzione.
Intanto complimenti per aver "sistemato" la sorgente X per il Foglio2. Bravo.

Dunque.
Li scrive sempre nella stessa riga per una mia svista. Occorre dirgli la posizione, cioè bisogna riportare tutto quello che si riferisce a posV e posO come per Foglio1. Vedi la macro aggiornata sotto.

Per quanto attiene l'eliminazione dei grafici a me li elimina tutti.
In merito al problema del primo grafico ancora non ho risolto.

Fai sapere. Ciao,
Mario

PS. Ho corretto la macro anche per quanto riguarda il problema del primo grafico
aggiungendo le righe
For x = .SeriesCollection.Count To 2 Step -1
.SeriesCollection(2).Delete
Next x

Option Explicit

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart(), a As Integer, j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then
        ReDim Preserve nomichart(1 To ws.Shapes.Count)
        a = 1
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "Pompa" Then nomichart(a) = oChar.Name: a = a + 1
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If ws.Shapes.Count > 0 Then
            For k = 1 To UBound(nomichart)                               'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(k) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        If Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
        'altrimenti crea i 4 grafici
        valoreX = "Foglio1!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then ltr = "A": posO = 30
            If k = 2 Then ltr = "B": posO = 305
            If k = 3 Then ltr = "C": posO = 580
            If k = 4 Then ltr = "D": posO = 855
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "Foglio1!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            'Stop
            With oChar.Chart
                .ChartType = xlXYScatterSmooth
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
                For x = .SeriesCollection.Count To 2 Step -1
                    .SeriesCollection(2).Delete
                Next x
            End With
            'posizione
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 230
            End With
            nm = ""
        Next k
'controlla se vi sono dati in Foglio2 e, in caso positivo, aggiunge le serie
        With Worksheets(2)
            If .Cells(i, 5) = "" Then GoTo 2  'in mancanza di dati passa oltre senza creare i grafici
            'altrimenti
            valoreX = "Foglio2!$E$" & i & ":$V$" & i
            For k = 1 To 4
                If k = 1 Then ltr = "A": posO = 30
                If k = 2 Then ltr = "B": posO = 305
                If k = 3 Then ltr = "C": posO = 580
                If k = 4 Then ltr = "D": posO = 855
                nm = .Cells(i, 1) & ltr
                oChar.Name = nm
                valoreY = "Foglio2!$E$" & i + k & ":$V$" & i + k
                ActiveSheet.ChartObjects(nm).Activate
                ActiveChart.SeriesCollection.Add Source:=valoreY            'posizione
                posV = Cells(i + 5, 2).Top + 10
                With ActiveSheet.ChartObjects(nm)
                    .Left = posO
                    .Top = posV
                End With
                nm = ""
            Next k
        End With
        valoreX = "": valoreY = ""
2   Next i
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

di Vespa130 (utente non iscritto) data: 07/12/2016 17:47:35
Ciao Mario!!!
Perfetto, abbiamo raggiunto il mio obiettivo .
Ne è uscita un'ottima macro che ha svolto pienamente il suo lavoro .
Ti allego la macro aggiornata a cui ho aggiunto l'inserimento dei nomi sugli assi del grafico e apportato piccole modifiche alle ultime righe che mi avevi allegato, in modo da eliminare tutte le curve prima di crearne di nuove, così da essere sicuro:

For h = oChar.Chart.SeriesCollection.Count To 1 Step -1
.SeriesCollection(h).Delete
Next h

Grazie mille per la pazienza e il grosso aiuto!! Molto gentile .

Buona serata
Mirco

Sub CreazioneGrafici()
Dim uRiga As Long, i As Long, h As Long, k As Long, posO As Double, posV As Double
Dim valoreX As String, valoreY As String, Yaxes As String, ltr As String, nm As String
Dim wb As Workbook, ws As Worksheet
Dim oChar As Shape, nomichart(), a As Integer, j As Integer
Set wb = ThisWorkbook
Set ws = wb.Worksheets(3)
Range("D5").Select
    'popolo una matrice coi nomi dei grafici presenti
    If ws.Shapes.Count > 0 Then                 'controlla che ci siano figure (ce ne deve essere almeno una per generare la matrice)
        ReDim Preserve nomichart(1 To ActiveSheet.Shapes.Count)
        a = 1
        For Each oChar In ActiveSheet.Shapes
            If Left(oChar.Name, 5) = "POMPA" Then nomichart(a) = oChar.Name: a = a + 1   'se la parte sinistra della A5 contiene il nome "POMPA", assegna al grafico un num progressivo
        Next
    End If
    'individuo l'ultima riga piena
    uRiga = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To uRiga Step 23
        If ws.Shapes.Count > 0 Then
            For k = 1 To UBound(nomichart)                               'scorro i grafici presenti
                If Cells(i, 1) & "A" = nomichart(k) Then GoTo 2       'se già presente passo al prossimo
            Next k
        End If
        valoreX = "'Curve output'!$E$" & i & ":$V$" & i
        For k = 1 To 4
            Set oChar = ws.Shapes.AddChart
            If k = 1 Then
            ltr = "A"
            posO = 30
            Yaxes = "m"
            End If
            If k = 2 Then
            ltr = "B"
            posO = 305
            Yaxes = "kW"
            End If
            If k = 3 Then
            ltr = "C"
            posO = 580
            Yaxes = "%"
            End If
            If k = 4 Then
            ltr = "D"
            posO = 855
            Yaxes = "m"
            End If
            nm = Cells(i, 1) & ltr
            oChar.Name = nm
            valoreY = "'Curve output'!$E$" & i + k & ":$V$" & i + k
            Range("E" & i + k & ":V" & i + k).Select
            'Stop
            With oChar.Chart
                For h = oChar.Chart.SeriesCollection.Count To 1 Step -1     'appena creo il grafico, cancello tutte le serie già presenti, dalla prima fino all'ultima andando a ritroso
                .SeriesCollection(h).Delete
                Next h
                .ChartType = xlXYScatterSmooth
                .SeriesCollection.NewSeries
                .SeriesCollection(1).XValues = valoreX
                .SeriesCollection(1).Values = valoreY
                .Legend.Delete
            End With
            oChar.Chart.Axes(xlCategory).HasTitle = True
            oChar.Chart.Axes(xlCategory).AxisTitle.Text = "mc/h"
            oChar.Chart.Axes(xlValue).HasTitle = True
            oChar.Chart.Axes(xlValue).AxisTitle.Text = Yaxes
            posV = Cells(i + 5, 2).Top + 10
            With ActiveSheet.ChartObjects(nm)
                .Left = posO
                .Top = posV
                .Width = 260
                .Height = 220
            End With
            nm = ""
        Next k
        'prende i dati in 'Dati da SAP' e aggiunge le serie anche se non ci sono dati
        With Worksheets(1)
            valoreX = "'Dati da SAP'!$E$" & i & ":$V$" & i
            For k = 1 To 4
                If k = 1 Then ltr = "A": posO = 30
                If k = 2 Then ltr = "B": posO = 305
                If k = 3 Then ltr = "C": posO = 580
                If k = 4 Then ltr = "D": posO = 855
                nm = .Cells(i, 1) & ltr
                oChar.Name = nm
                valoreY = "'Dati da SAP'!$E$" & i + k & ":$V$" & i + k
                ActiveSheet.ChartObjects(nm).Activate
                ActiveChart.SeriesCollection.NewSeries
                ActiveChart.SeriesCollection(2).XValues = valoreX
                ActiveChart.SeriesCollection(2).Values = valoreY
                posV = Cells(i + 5, 2).Top + 10
                With ActiveSheet.ChartObjects(nm)
                    .Left = posO
                    .Top = posV
                End With
                nm = ""
                Next k
        End With
        valoreX = "": valoreY = ""
2   Next i
Range("A1").Select      'si posiziona nella cella A1 per comodità
Set oChar = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub

di Marius44 data: 07/12/2016 19:01:18
Ciao Mirko

Grazie per il gradito riscontro. Son contento che il problema sia risolto.

Alla prossima. Ciao,
Mario

Vuoi Approfondire?