la macro che segue "dovrebbe" costruire un grafico su un foglio separato e quindi copiarlo in un altro foglio riducendone opportunamente le dimensioni.
Il problema è che non segue la logica che vorrei , ovvero :
crea grafico1, copia, cancella grafico1 e resta predisposto per nuova importazione dei dati.
Nota, i dati vengono importati da un file CSV tramite macro di chiamata, in questa stessa macro ho inserito il Call Test.
Cosa mi succede? a volte il grafico 1 diventa grafico 2 etc e va tutto in palla, le due parti della macro non sono coordinate .
Quota:
Sub Test() ' crea grafico
Dim LastRow As Long
Dim Rng1 As Range
Dim rng2 As Range
Dim ShName As String
With ActiveSheet ' qui seleziono ultima riga e range dati
LastRow = .Range("K" & .Rows.Count).End(xlUp).Row
Set Rng1 = .Range("K2:K" & LastRow & ", L1:L" & LastRow)
'Set rng2 = .Range("L2:L" & LastRow)
ShName = .Name
End With
Charts.Add
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=Rng1
With .SeriesCollection.NewSeries
'.Values = rng2
.AxisGroup = 2
End With
.Location Where:=xlLocationAsObject, Name:=ShName
End With ' fine macro di preparazione del grafico
'copia grafico1 a Storico_CSV
Sheets("Grafico1").Activate
ActiveSheet.Unprotect
ActiveChart.Legend.Select
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Storico_CSV").Activate
Sheets("Storico_CSV").Unprotect
Range("A5").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects("Grafico1").Activate
ActiveSheet.Shapes("Grafcico1").ScaleWidth 0.9865924553, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Grafico1").ScaleHeight 0.9701706491, msoFalse, _
msoScaleFromBottomRight
ActiveWindow.SmallScroll Down:=12
ActiveSheet.ChartObjects("Grafico1").Activate
ActiveSheet.Shapes("Name").ScaleWidth 0.9833852544, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Name").ScaleHeight 0.7638077647, msoFalse, _
msoScaleFromTopLeft
'ActiveWindow.ScrollRow = 1
Sheets("Grafico1").Select
ActiveWindow.SelectedSheets.Delete
ActiveSheet.Protect
End Sub
|
Modifica .
Questa macro funziona bene su un grafico esistente (come struttura ed impostazione ) e lo aggiorna perfettamente .
Quota:
Sub Test() ' crea grafico
Dim LastRow As Long
Dim Rng1 As Range
Dim rng2 As Range
Dim ShName As String
With ActiveSheet ' qui seleziono ultima riga e range dati
LastRow = .Range("K" & .Rows.Count).End(xlUp).Row
Set Rng1 = .Range("K2:K" & LastRow & ", L1:L" & LastRow)
'Set rng2 = .Range("L2:L" & LastRow)
ShName = .Name
End With
Range("A1").Select
End Sub
|