copia e rinomina grafico

[piter123]

salve, avrei bisogno di un codice vb per selezionare un foglio, copiarlo e poter rinominare la copia in modo tale da poterla successivamente (sempre tramite vb) riselezionarla e modificarne le scale, le dimensioni ecc.
Per quanto riguarda la selezione e copia e incolla no problem, ma come faccio a riselezionare la copia per modificarne il nome e fare le modifiche di scala e dimensioni ?

ActiveSheet.ChartObjects("Grafico 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Range("K4").Select
ActiveSheet.Paste



grazie

[Anthony47]

Puoi ottenere il nome del grafico (o altra forma) che insiste su K4 con:

Codice: Seleziona tutto

For Each Pict In ActiveSheet.Shapes
  If Pict.TopLeftCell.Address = "$K$4" Then
  NomeImm = Pict.Name: Exit For
  End If
Next Pict

Il nome viene restituito nella variabile NomeImm; per selezionarlo userai

Codice: Seleziona tutto

ActiveSheet.Shapes(NomeImm).Select

Ciao.

[piter123]

Perfetto grazie, nel frattempo avevo risolto in maniera meno nobile in questo modo :
nel foglio 1 ho inserito (intanto per prova, poi il codice verrà inserito in una routine più complessa) il seguente codice
Private Sub CommandButton33_Click()
ActiveSheet.ChartObjects("Grafico 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Sheets("HOME").Select
Sheets("HOME").Range("J4").Select
ActiveSheet.Paste
Sheets("HOME").Range("B3") = Mid(ActiveChart.Name, 6, 17)
end sub

il quale estrae e copia in una cella il nome del grafico.


Successivamente nel foglio "HOME" intanto sempre per prova ho inserito in un commandbutton il seguente codice per ridimensionare il grafico
Private Sub CommandButton2_Click()
nomegraf = Range("b3")
ActiveSheet.ChartObjects(nomegraf).Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes(nomegraf).ScaleWidth 0.47, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(nomegraf).ScaleHeight 0.6, msoFalse, _
msoScaleFromTopLeft
ActiveWindow.Visible = False
end sub

se però copio il secondo codice in cascata al primo

Private Sub CommandButton33_Click()
ActiveSheet.ChartObjects("Grafico 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Sheets("HOME").Select
Sheets("HOME").Range("J4").Select
ActiveSheet.Paste
Sheets("HOME").Range("B3") = Mid(ActiveChart.Name, 6, 17)

nomegraf = Range("b3")
ActiveSheet.ChartObjects(nomegraf).Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes(nomegraf).ScaleWidth 0.47, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(nomegraf).ScaleHeight 0.6, msoFalse, _
msoScaleFromTopLeft
ActiveWindow.Visible = False

End Sub

mi copia dal foglio1 al foglio home il grafico ma quando arriva alla perte di ridimensionamento di dà errore runtime 1004
"impossibile trovare la proprietà chartobjects per la classe worksheet." e evidenzia la riga
ActiveSheet.ChartObjects(nomegraf).Activate

Perchè ?, dove sbaglio ?

[Anthony47]

Prova a usare questa istruzione al posto di quella che usi ora:

Codice: Seleziona tutto

nomegraf = Sheets("HOME").Range("b3")

altrimenti leggi B3 del foglio di origine, quello a cui appartiene il codice in esecuzione.

Ciao.