[VBA] - Modificare grafico Excel con VBA

[lucausa75]

Salve ragazzi,

ho creato la seguente tabella di dati tramite Excel:

http://img147.imageshack.us/img147/8035/50293257zw6.jpg (http://imageshack.us)

E realizzato quindi il seguente grafico:

http://img518.imageshack.us/img518/3136/87109928sy4.jpg (http://imageshack.us)

Tramite una macro volevo VBA fare in modo di modificare il grafico già esistente ma con la possibilità di scegliere un range di mesi sempre consecutivi.
Esempio da Marzo a Giugno oppure da Gennaio a Maggio e così via.

http://img143.imageshack.us/img143/8734/40309396cb6.jpg (http://imageshack.us)

Mi aiutate a realizzare questa macro?

In allegato ttrovate il file Excel in formato zip

[MarcoGG]

Interessante quesito.
Beh, questo sì che è il modo di porre una domanda ! :D

Non ti sei certo semplificato la vita nel progettare la cosa ( 3 cosucce su 3 fogli differenti, ma immagino sia solo un assaggio di una qualcosa di più grande che vorrai implementare... ).

Venendo al sodo, la risolverei così :

1. Codice da mettere in un Modulo VBA :
Public Function letteraCol(nomeFoglio As String, val As Integer) As String

Sheets(nomeFoglio).Select
letteraCol = Left(Cells(1, val).Address(1, 0), InStr(1, Cells(1, val).Address(1, 0), "$") - 1)

End Function

Public Sub AggiornaGrafico(nomeGrafico As String, meseDA As String, meseA As String)

Dim indMeseDA As String
Dim indMeseA As String
Dim R As Range
Set R = Sheets("Elenco").Range("A1:G4").Find(meseDA, lookat:=xlPart)
indMeseDA = R.Address
Set R = Worksheets("Elenco").Range("A1:G4").Find(meseA, lookat:=xlPart)
indMeseA = letteraCol("Elenco", R.Column) & "4"
Sheets("Grafico").Select
ActiveSheet.ChartObjects(nomeGrafico).Activate
ActiveChart.SetSourceData Source:=Sheets("Elenco").Range("A1:A4," & indMeseDA & ":" & indMeseA), PlotBy:=xlRows

End Sub

Codice Pulsante :

Private Sub CommandButton1_Click()

'Nome Grafico:
Dim nomeGr As String
Dim GR As ChartObject
For Each GR In Sheets("Grafico").ChartObjects
nomeGr = GR.Name
Exit For
Next
AggiornaGrafico nomeGr, Range("B6").Text, Range("B7").Text

End Sub

Prova... ;)

[lucausa75]

Interessante quesito.
Beh, questo sì che è il modo di porre una domanda ! :D

Non ti sei certo semplificato la vita nel progettare la cosa ( 3 cosucce su 3 fogli differenti, ma immagino sia solo un assaggio di una qualcosa di più grande che vorrai implementare... ).

Venendo al sodo, la risolverei così :

1. Codice da mettere in un Modulo VBA :
Public Function letteraCol(nomeFoglio As String, val As Integer) As String

Sheets(nomeFoglio).Select
letteraCol = Left(Cells(1, val).Address(1, 0), InStr(1, Cells(1, val).Address(1, 0), "$") - 1)

End Function

Public Sub AggiornaGrafico(nomeGrafico As String, meseDA As String, meseA As String)

Dim indMeseDA As String
Dim indMeseA As String
Dim R As Range
Set R = Sheets("Elenco").Range("A1:G4").Find(meseDA, lookat:=xlPart)
indMeseDA = R.Address
Set R = Worksheets("Elenco").Range("A1:G4").Find(meseA, lookat:=xlPart)
indMeseA = letteraCol("Elenco", R.Column) & "4"
Sheets("Grafico").Select
ActiveSheet.ChartObjects(nomeGrafico).Activate
ActiveChart.SetSourceData Source:=Sheets("Elenco").Range("A1:A4," & indMeseDA & ":" & indMeseA), PlotBy:=xlRows

End Sub

Codice Pulsante :

Private Sub CommandButton1_Click()

'Nome Grafico:
Dim nomeGr As String
Dim GR As ChartObject
For Each GR In Sheets("Grafico").ChartObjects
nomeGr = GR.Name
Exit For
Next
AggiornaGrafico nomeGr, Range("B6").Text, Range("B7").Text

End Sub

Prova... ;)


Grazie 1000! :D

Invece adesso vorrei creare un bottone all'interno del quale inserire il codice in modo da copiare su un Foglio SETUP del file Template.xls il contenuto della prima riga di un foglio FOGLIO1 che sta in un altro foglio Excel: Elenco da copiare.xls così da avere il seguente foglio con accanto il numero progressivo:

http://d.imagehost.org/0221/Anonimo.jpg (http://d.imagehost.org/download/0221/Anonimo.bmp)

Quì potete scaricare il file xls zippato: http://cid-57f2531272604143.skydrive.live.com/self.aspx/Pubblica/Copiare%20righe%20Excel.zip

Grazie ancora!

[MarcoGG]

Ci si può costruire una Function che, chiamata n volte in un ciclo, vada a leggere tutti i valori del file .xls desiderato, senza bisogno di aprirlo.
Una cosa del genere :

Public Function LeggiValore(percorsoWBook As String, nomeWBook As String, nomeWSheet As String, indirizzo As String) As Variant

Dim strMacro As String
strMacro = "'" & percorsoWBook & "[" & nomeWBook & "]" & nomeWSheet & "'!" & Range(indirizzo).Address(True, True, xlR1C1)
LeggiValore = ExecuteExcel4Macro(strMacro)

End Function

;)