Quotazionoi di borsa

[Ma85]

Buonasera, sono nuovo iscritto al forum. Ho la necessità di importare in un foglio excel le quotazioni storiche di un titolo.
Per es.: importare le quotazioni storiche (dalla data più remota disponibile fino alla data di estrazione) del titolo ENI e del titolo ENEL rispettivamente nel foglio ENI e foglio ENEL. Normalmente i dati estratti si riassumono nelle colonne: data, prezzo di apertura, massimo, minimo, prezzo di chiusura, prezzo di chiusura aggiustata (eventuale), Volume.

Con le query web non ci riesco perché mi appaiono molteplici errori di script.
Credo sia possibile anche con delle macro però non conosco il linguaggio VBA.

Potete aiutarmi.

Grazie anticipatamente.
Sposto, aurelio37

[Anthony47]

Ciao Ma85, benvenuto nel forum.
Siamo in un forum di Applicazioni Office, non di Finanza; quindi dovresti dire su quale sito e quale pagina sono disponibili le informazioni di cui parli e poi vedremo come estrarle.

Ti aspettiamo con queste informazioni...

[EnricoBanco]

Ciao a tutti, Anthony se posso, mi sto interessando allo scarico dati da web. È un argomento molto interessante. Allora ho provato a scaricare da Yahoo Finanza utilizzando lo scarico dati da web di Excel. È vero che da un pò di errori script ma poi "forzandolo" ad andare avanti comunque scarica la tabella dei dati storici. Bisogna attivare lo il Dati\Carica da Web. Appare sul foglio excel una videata del sito web, si inserisce l'indirizzo desiderato e lui lo trova. Poi compare una freccetta verde in alto a sinistra, luccala e la query web consente di importare i dati. Scarica di base sei mesi quindi se fai una registrazione macro mentre excel scarica poi ti trovi il codice su un indirizzo web impostato per esemopio appunto Yahoo Finanza e su un titolo impostato. Funziona, ma la query web scarica anche una serie di informazioni inutili tipo titoli di pubblicità che sono ai lati della pagina web e che si possono cancellare eliminando la riga excel dove li scarica. Ma a me sinceramente non piace molto lasciare le cose statiche ma le preferisco dinamiche quindi ho cercato il codice in rete per scaricare i dati da web tenendo nel codice fisso il sito ma inserendo il nome della pagina in una input box. Trovato, testato e funziona

[EnricoBanco]

Ma il codice con input box si perde alcuni dati tra cui il nome del titolo allora ho provato a combinare i due metodi e funziona

[EnricoBanco]

Nell'input box si deve inserire il nome della pagina come specificato per esempio all'inizio del codice nella parte commento con la sigla del titolo che si ottiene facilmente collegandosi a Yahoo FInanza, poi Quotazioni, Piazza Affari, sulla destra si seleziona un titolo nel box "Cerca quotazioni", si seleziona quello in relazione al mercato di interesse. Nell'indirizzo web appara questa stringa:
https://it.finance.yahoo.com/quote/SIGLA TITOLO/?p=SIGLA TITOLO

Quindi nell'input box della macro si inserisce la stringa:
SIGLA TITOLO/history?p=SIGLA TITOLO

Facendo più scarichi ho notato che lo scarico precedente lo sposta sulla destra del foglio quindi all'inizio della macro c'è un cancella dati. Alla fine un pò di formazione per il titolo in grassetto ed elimina righe (secondo me) inutili. Io ho windows 7 ed excel 10. Se vedi il foglio excel dopo che hai lanciato la macro, n basso a destra appare il messaggio "Copia dei dati da web in corso". Ho lasciato msg box che appare alla fine (indica il numero 1). Il codice che assembla la query web creata da macro excel ed il codice trova su web è il seguente.

Codice: Seleziona tutto

Range("A1:AZ500").Value = ""
  Dim oSh As Worksheet
    Set oSh = ActiveSheet 'Oppure nome altro foglio
    With oSh.QueryTables.Add( _
       "URL;https://it.finance.yahoo.com/quote/[""Immettere URL""].htm", oSh.Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
         On Error Resume Next
        .Refresh BackgroundQuery:=False
        MsgBox .Parameters.Count
       With .Parameters(1)
           .SetParam xlRange, oSh.Range("AR300")
          .RefreshOnChange = True
                   
        'Cancella righe non utili
        Rows("1:57").Delete
        Rows("3:15").Delete
        Rows("126:300").Delete
       
        'Inserisce fonte dati
         Cells(1, 2) = "Fonte: Yahoo Finanza"
       
         Range("A1").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
       
        Range("B1").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
       
       End With
    End With
       
End Sub

[Ma85]

Salve. Mi scuso con Voi se non sono stato molto preciso.
Le informazioni che devo utilizzare sono nella pagina web di yahoo finanza effettuando le seguenti scelte:

- titolo: Eni.Mi
- scheda: dati storici;

Una volta fatto queste scelte occorre scegliere:
- periodo: scegliendo il periodo massimo disponibile;
- mostra: restando l'impostazione di default, ossia prezzi storici;
- frequenza: restando l'impostazione di default, ossia giornaliera;

Cliccando su applica visualizzo i dati in funzione delle scelte effettuate. A questo punto mi servirebbe importare i dati in excel usando le colonne così come riportato sul sito, ossia Data, Prezzo Apertura, Massimo, Minimo, Presso di chiusura, Prezzo di chiusura aggiustata, Volume.

Sulla barra degli indirizzi, dopo aver scelto il titolo, mi appare il seguente url:
https://it.finance.yahoo.com/quote/ENI.MI?p=ENI.MI

Dopo aver effettuato la scelta "dati sotrici" mi appare il seguente url:
https://it.finance.yahoo.com/quote/ENI.MI/history?p=ENI

Dopo aver effettuato le altre scelte mi appare il seguente url:
https://it.finance.yahoo.com/quote/ENI. ... equency=1d

Vi ringrazio ancora per la vostra collaborazione.

[Anthony47]

Guarda, questi lavori richiedono tempo e pazienza, merce molto rara dalle mie parti...

Comunque, a scopo puramente ludico ho sviluppato questo codice prototipale che aiuta a importare il csv dei titoli che ti interessano:

Codice: Seleziona tutto

Dim IE As Object                 'RIGOROSAMENTE IN TESTA AL MODULO

Sub mMain()
Dim aColl As Object, bColl As Object, myTIT As String, myPath As String
'
myTIT = "ENEL"                               '<<< Il titolo, senza ".MI"
'myPath = "C:\PROVA"
Call ApriYF(myTIT)
Set aColl = IE.document.getElementById("Col1-1-HistoricalDataTable-Proxy") '.getElementsByTagName("input")
myWait (2)
mlink0 = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
'
aColl.getElementsByTagName("input")(0).Click
myWait (0.2)
'
Set bColl = IE.document.getElementsByClassName("P(5px) W(37px) H(15px) Fl(start) Mb(5px) Cur(p) Bdbc($c-fuji-blue-1-a):h Bdbs(s) Bdbw(3px) Bdbc(t)")
bColl(bColl.Length - 1).Click               'Max
myWait (0.2)
'
IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Miw(80px)! Fl(start)")(0).Click   'Finito
myWait (0.2)
'
IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Fl(end)")(0).Click                'Applica
myWait (0.2)
mlink = mlink0
On Error Resume Next
mytim = Timer
Do
    mlink = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
    If Mid(mlink, InStr(1, mlink, "?period1", vbTextCompare) + 8, 7) <> _
     Mid(mlink0, InStr(1, mlink0, "?period1", vbTextCompare) + 8, 7) Then Exit Do
    If Timer > (mytim + 15) Then Exit Do
Loop
'Debug.Print Format(Timer - mytim, "0.00")
'Debug.Print 1, mlink0
'Debug.Print 2, mlink
On Error GoTo 0
myWait (0.5)
'GoTo impF
    IE.navigate mlink
myWait (0.2)
    mytim = Timer
    Do While IE.Busy
        DoEvents: If Timer > (mytim + 10) Then Exit Do:
    Loop           'Attesa not busy
    Do While IE.readyState <> 4
        DoEvents: If Timer > (mytim + 30) Then Exit Do
    Loop  'Attesa documento
On Error Resume Next
IE.Quit
Set IE = Nothing

End Sub

Sub ApriYF(ByVal myID As String, Optional mySt As Long = 0)
'
bURL = "https://it.finance.yahoo.com/quote/###.MI/history?p=###"
'Set IE = Nothing
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate Replace(bURL, "###", myID, , , vbTextCompare)
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
If mySt > 0 Then Stop
End Sub

Private Sub myWait(ByVal WSec As Single, Optional ByVal TOut As Single = 10)
'Attende WSec secondi (o il doppio se mezzanotte)
Dim lTim As Single
'
lTim = Timer
Do
    DoEvents
    If Timer > (lTim + WSec) Then Exit Do
    DoEvents
    If Timer < lTim And Timer > WSec Then Exit Do
Loop
End Sub


Va messo all'interno di un Modulo vba standard, e all'occorrenza va lanciata la Sub mMain; la riga marcata <<< definisce il titolo da importare.
Per un funzionamento automatico I.E. deve essere impostato su "Scarica automaticamente"; ho pero' paura che nelle ultime versioni del SO / IE questa opzione potrebbe non esistere piu'. In questo caso IE a un cero punto ti chiedera' cosa vuoi fare del file XXX.csv (Aprirlo / Salvarlo) e sceglierai Salvare.

Una volta che il csv e' sul pc do' per scontato che sai come fare a importarlo su excel, nel file e nella posizione giusta; se vuoi automatizzare la procedura ti bastera' registrare un macro mentre importi il file csv, e poi richiamare la macro dopo l'importazione del file.

Ciao

Keyw:
yahoo finance download historical data Milan stockmarket Scarica dati storici borsa milano

[Ma85]

Grazie per la tempestività e per quanto svolto. Quando eseguo la macro mi appare il seguente errore:
Errore di run-tim 438:
Proprietà o metodo non supportato dall'oggetto.

Se faccio debug si posizione sul seguente rigo:
mlink0 = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href

Non saprei come fare per andare avanti.

[Anthony47]

Probabilmente hai IE 9 o precedente, in questo caso ti chiedo di aggiornarlo a IE11.

Ciao

[EnricoBanco]

Grazie Anthony,
con la tua macro è possibile scaricare un anno di dati da Yahoo Finanza, la macro registrata in excel invece scarica sei mesi.
Ci ho lavorato un pò. in quanto volevo cercare un modo per caricare il file cvs tramite una macro. Ho provato a registrarla e non aggiorna il formato dei dati in modo corretto. Allora ho trovato in rete questa, di seguito indicata. Invece la macro registrata "Ordina_data" lavora correttamente. Infine una macro che le lancia tutte.

Nella tua macro per collegarsi a Yahoo Finanza e scaricare i dati in formato .csv, ho aggiunto

Codice: Seleziona tutto

myTIT = Range("$A$1").Value"

così indico nel foglio excel quale titolo scaricare. Ho dovuto apostrofare alcune righe ma poi il collegamento e lo scarico mi funziona comunque correttamente.

Codice: Seleziona tutto

Dim IE As Object                 'RIGOROSAMENTE IN TESTA AL MODULO

'Scarica i dati di un anno da Yahoo Finanza su una file csv

Sub mMain()


Dim aColl As Object, bColl As Object, myTIT As String, myPath As String
'
'myTIT = "ENEL"    '<<< Il titolo, senza ".MI"
myTIT = Range("$A$1").Value


'myPath = "C:\PROVA"
Call ApriYF(myTIT)
Set aColl = IE.document.getElementById("Col1-1-HistoricalDataTable-Proxy") '.getElementsByTagName("input")
myWait (2)
mlink0 = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
'
'aColl.getElementsByTagName("input")(0).Click
myWait (0.2)
'
Set bColl = IE.document.getElementsByClassName("P(5px) W(37px) H(15px) Fl(start) Mb(5px) Cur(p) Bdbc($c-fuji-blue-1-a):h Bdbs(s) Bdbw(3px) Bdbc(t)")
'bColl(bColl.Length - 1).Click               'Max
myWait (0.2)
'
'IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Miw(80px)! Fl(start)")(0).Click   'Finito
myWait (0.2)
'
IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Fl(end)")(0).Click                'Applica
myWait (0.2)
mlink = mlink0
On Error Resume Next
mytim = Timer
Do
    mlink = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
    If Mid(mlink, InStr(1, mlink, "?period1", vbTextCompare) + 8, 7) <> _
     Mid(mlink0, InStr(1, mlink0, "?period1", vbTextCompare) + 8, 7) Then Exit Do
    If Timer > (mytim + 15) Then Exit Do
Loop
'Debug.Print Format(Timer - mytim, "0.00")
'Debug.Print 1, mlink0
'Debug.Print 2, mlink
On Error GoTo 0
myWait (0.5)
'GoTo impF
    IE.navigate mlink
myWait (0.2)
    mytim = Timer
    Do While IE.Busy
        DoEvents: If Timer > (mytim + 10) Then Exit Do:
    Loop           'Attesa not busy
    Do While IE.readyState <> 4
        DoEvents: If Timer > (mytim + 30) Then Exit Do
    Loop  'Attesa documento
On Error Resume Next
IE.Quit
Set IE = Nothing

End Sub



Sub ApriYF(ByVal myID As String, Optional mySt As Long = 0)
'
bURL = "https://it.finance.yahoo.com/quote/###.MI/history?p=###"
'Set IE = Nothing
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate Replace(bURL, "###", myID, , , vbTextCompare)
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
If mySt > 0 Then Stop
End Sub



Private Sub myWait(ByVal WSec As Single, Optional ByVal TOut As Single = 10)
'Attende WSec secondi (o il doppio se mezzanotte)
Dim lTim As Single
'
lTim = Timer
Do
    DoEvents
    If Timer > (lTim + WSec) Then Exit Do
    DoEvents
    If Timer < lTim And Timer > WSec Then Exit Do
Loop
End Sub

La macro per importare i dati in excel

Codice: Seleziona tutto

Option Explicit

Sub ImportaDati()

Range("A2:G1000").Value = ""

 Application.UseSystemSeparators = False
    Application.DecimalSeparator = "."
    Application.ThousandsSeparator = ","

    With _
        ActiveSheet.QueryTables.Add _
        (Connection:="TEXT;C:\Users\Windows7\Downloads\ENEL.csv", _
        Destination:=Range("$A$2"))
       .FieldNames = True
       
        .PreserveFormatting = True
     
        .SaveData = True
        .AdjustColumnWidth = True
     
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
     
        .TextFileCommaDelimiter = True
       
        .TextFileColumnDataTypes = Array(xlGeneralFormat, xlGeneralFormat, _
            xlGeneralFormat, xlGeneralFormat, _
            xlGeneralFormat, xlGeneralFormat)

        .Refresh
       
       Columns("F:F").Select
       Columns("F:F").Delete
    End With
   
End Sub

La macro per ordinare la data

Codice: Seleziona tutto

Sub Ordina_data()

    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange Range("A3:F1000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 End Sub

La macro (trovata in rete) per cancellare righe vuole, se serve, devo fare un pò di prove con i grafici

Codice: Seleziona tutto

Sub Cancella_righe_vuote()

 Dim i As Long, LastRow As Long
 LastRow = Range("A" & Rows.Count).End(xlUp).Row
 Sheets("Foglio1").Select

 For i = LastRow To 1 Step -1
 If LCase(Cells(i, "A").Value) Like "" And _
 UCase(Cells(i, "B").Value) Like "" And _
 UCase(Cells(i, "C").Value) Like "" And _
 UCase(Cells(i, "D").Value) Like "" And _
 UCase(Cells(i, "E").Value) Like "" And _
 UCase(Cells(i, "F").Value) Like "" Then _
 Rows(i).EntireRow.Delete
 Next i
 End Sub

La macro che lancia tutte le macro

Codice: Seleziona tutto

Sub Lancia_tutte_le_macro()

Application.EnableEvents = False
Call mMain
Call ImportaDati
Call Ordina_data
Call Cancella_righe_vuote
Application.EnableEvents = True
End Sub

[Anthony47]

Grazie Enrico, stai dimostrando come con un po' di fantasia, anche solo col registratore di macro, si riesce a fare cose anche complesse.

Aggiungerei solo un paio di cose al tuo codice:
-supponiamo che il codice dei titolo sia in A1 di Foglio1, allora mettiamo la selezione di Foglio1 in testa alla macro:

Codice: Seleziona tutto

myTIT = Range("$A$1").Value
Sheets("Foglio1").Select                  '+++ Aggiunta


In testa alla Sub ImportaDati inseriamo la selezione del foglio con nome pari al Titolo:

Codice: Seleziona tutto

Sub ImportaDati()
'
Sheets(Sheets("Foglio1").Range("$A$1").Value).Select             '+++ Aggiunta
Range("A2:G1000").Value = ""


Il foglio deve gia' esistere.

Dopo l'importazione del file, killiamo il file appena importato, altrimenti la prossima volta il file si chiamera' TITOLO(2).csv e l'importazione sara' errata.
Il modo piu' semplice, in coda a Sub ImportaDati:

Codice: Seleziona tutto

    End With
On Error Resume Next                      '+++ Aggiungere queste 3 righe
Kill "C:\Users\Windows7\Downloads\" & Sheets("Foglio1").Range("A1").Value & ".csv"
On Error GoTo 0
End Sub


(oppure mettere il codice in testa alla mMain, prima di partire con la nuova importazione)

Quanto a cancellare le righe vuote, potresti semplificare con

Codice: Seleziona tutto

If Len(Cells(i, "A") & Cells(i, "B") & etc etc ) = 0 Then


Per curiosita', mi confermi che hai IE di versione >9?

Ciao

[EnricoBanco]

Ciao Anthony,
grazie mille per i consigli!!!
Ho IE 11, infatti con IE 11 funziona lo scarico dati. Prima avevo impostato come CROME come browser.
Grazie di tutto!!!
Ciao

[EnricoBanco]

Facendo un pò di prove, quando scarica i dati da Yahoo chiede sempre di salvare il file con il nome TITOLO.MI.csv, se si usa come nome del file il nome in A1 cioè TITOLO.csv e si cambia questa riga nella macro ImportaDati

Codice: Seleziona tutto

(Connection:="TEXT;C:\Users\Windows7\Downloads\ENEL.csv", _

con questa:

Codice: Seleziona tutto

(Connection:="TEXT;C:\Users\Windows7\Downloads\" & Sheets("Foglio1").Range("A1").Value & ".csv", _

mi sembra che il programma funzioni in modo più comodo. Se in A1 si mette TITOLO.MI la macro non riesce a scaricare i dati da Yahoo

[EnricoBanco]

Ho provato a fare un programma che elabora grafici di analisi tecnica. Spero sia utile a chi vuole applicarsi a questa materia magari per chi deve fare studi all'università o anche studi statistici. Più che altro a parte l'organizzazione dei dati, è stato una continua scoperta di come poter costruire grafici anche un pò complessi con diverse modalità:
1) da selezione libera (serie selrange_nome_grafico);
2) grafici da selezione fissa su foglio formule (Modulo11);
3) grafici da selezione fissa in foglio dedicato a ciascun grafico (serie Grafico_Nome_Foglio).
La soluzione 1) è stata veramente una scoperta interessante perchè costruisce il grafico in modo dinamico in base alla selezione desiderata. L'importante è selezionare i dati per quello specifico tipo di grafico.
Le varie modalità di costruzione del grafico mostrano quali dati vengono usati.
Ho provato a fare un calcolo di simulazione del trend del titolo un modello che calcola la media tra il valore della retta di regressione e media mobile a venti giorni.
Quindi si importa i dati come da macro di Anthony in foglio "Dati", si copiano in foglio "Formule" dove si elaborano tutti i vari oscillatori, supporti e resistenze (tre), alcuni grafici sono correlati anche dall'andamento del polinomiale con evidenza di R^2:
MACD
Relative Strengh Indicator
Previsione trend
Andamento storico e regressione

Fogli esistenti
Nel foglio "Dati" in A1 viene messo il nome del titolo.
Il foglio "Formule" viene alimentato dalla macro (dati ed intestazioni)
Il foglio "Controlli" contiene alcuni dati per far funzionare le macro:
in J2: il numero di dati per l'elaborazione della simulazione
in J4: il nome del titolo che viene poi collegato in A1 del foglio"Dati"
in J6: il nome del file pdf da scaricare con le informazioni della società (bisogna cercarlo e poi impostare il percorso)
in J8: il percorso completo da dove scaricare il file pdf
in J10: la directory di download
in J12: il numero di giorni per il calcolo della previsione (la macro cancella giorni di festa, sabati, domeniche e i due giorni di Pasqua e Pasquetta)
in J14: eventuale correttore per il calcolo dei valori di trend

Per questi ho notato che la regressione calcola valori troppo alti, l'intervallo di confidenza più bassi del valore del titolo.

Codice: Seleziona tutto

 Sub Lancia_tutte_le_macro()
'Lancia tutte le macro
Application.EnableEvents = False

Call Copia_file ' Esegue copia di backup del file
Call mMain ' Scarica i dati di un anno da Yahoo Finanza su una file csv
Call Cancella_Grafici ' Cancella Grafici sul Foglio1 e singolo foglio intestato ai grafici
Call Cancella_bilancio ' Cancella tabella bilancio (fonte: http://www.evaluation.it/)
Call ImportaDati ' Cancella e importa dati quotazioni
Call Scocca ' Scocca
Call Formule ' Formule
Call Cancella_righe_vuote_dopo_copia_incolla_formule ' Cancella righe vuote dopo copia-incolla formule
Call Grafici ' Grafici su foglio Formule
Call Grafico_chiusura_Regressione_Foglio ' Grafico chiusura Regressione Foglio
Call Grafico_Relative_Strenght_Indicator_Foglio ' Grafico Relative Strenght Indicator Foglio
Call Grafico_Chiusura_Supporti_e_Resistenze_Foglio ' Grafico Chiusura Supporti e Resistenze Foglio
Call Grafico_MACD_Foglio ' Grafico MACD Foglio
Call Scarica_Bilancio_Enel_Tabella_su_excel ' Scarica blancio tabella su excel (fonte: http://www.evaluation.it/)
Call Scarica_Bilancio_Enel_File ' Scarica Bilancio Enel
Call Colonna_data_per_simulazione ' Colonna data per simulazione (in colonna A)
Call Data_per_calcolo_dati_di_previsione ' Incremento colonna dati in G numero data per calcolo dati di previsione
Call Regressione_per_calcolo_dati_di_previsione ' Incremento colonna dati in AH della regressione per calcolo dati di previsione.
Call Media_mobile_a_20_giorni ' Incremento colonna dati in AG della media mobile a 20 giorni per calcolo dati di previsione
Call Calcola_dati_previsione ' Calcola dati previsione in colonna E (altro metodo di calcolo dati previsione - macro 17)
Call R1_per_calcolo_dati_di_previsione ' R1 per calcolo dati di previsione
Call S1_per_calcolo_dati_di_previsione ' S1 per calcolo dati di previsione
Call R2_per_calcolo_dati_di_prevision ' R2 per calcolo dati di previsione
Call S2_per_calcolo_dati_di_previsione ' S2 per calcolo dati di previsione
Call R3_per_calcolo_dati_di_previsione ' R3 per calcolo dati di previsione
Call S3_per_calcolo_dati_di_previsione ' S3 per calcolo dati di previsione
Call Cancella_righe_dopo_dati_previsione ' Cancella righe con data non valorizzata dopo elaborazone dati previsione
Call Grafico_previsione ' Grafico previsione
Call Grafico_previsione_Foglio ' Grafico previsione foglio
Call Grafico_Dettaglio_Previsione_Foglio ' Grafico Dettaglio Previsione con un mese di dati
Application.EnableEvents = True
MsgBox "Elaborazione terminata"
End Sub

Codice: Seleziona tutto

Sub Copia_file()
With ActiveWorkbook
   .SaveCopyAs .Path & "\" & Format(Date, "yyyymmdd") & "Back-up" & " " & [AC8] & "Scarico dati da Yahoo Finance" & [AD8] & ".xlsm"
End With
End Sub

Codice: Seleziona tutto

Dim IE As Object                 'RIGOROSAMENTE IN TESTA AL MODULO
'Scarica i dati di un anno da Yahoo Finanza su una file csv
Sub mMain()
Dim aColl As Object, bColl As Object, myTIT As String, myPath As String
'
'myTIT = "ENEL"    '<<< Il titolo, senza ".MI"
Sheets("Dati").Select
If Range("A1").Value = "" Then Exit Sub
myTIT = Range("A1").Value

'myPath = "C:\PROVA"
Call ApriYF(myTIT)
Set aColl = IE.document.getElementById("Col1-1-HistoricalDataTable-Proxy") '.getElementsByTagName("input")
myWait (2)
mlink0 = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
'
'aColl.getElementsByTagName("input")(0).Click
myWait (0.2)
'
Set bColl = IE.document.getElementsByClassName("P(5px) W(37px) H(15px) Fl(start) Mb(5px) Cur(p) Bdbc($c-fuji-blue-1-a):h Bdbs(s) Bdbw(3px) Bdbc(t)")
'bColl(bColl.Length - 1).Click               'Max
myWait (0.2)
'
'IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Miw(80px)! Fl(start)")(0).Click   'Finito
myWait (0.2)
'
IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Fl(end)")(0).Click                'Applica
myWait (0.2)
mlink = mlink0
On Error Resume Next
mytim = Timer
Do
    mlink = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
    If Mid(mlink, InStr(1, mlink, "?period1", vbTextCompare) + 8, 7) <> _
     Mid(mlink0, InStr(1, mlink0, "?period1", vbTextCompare) + 8, 7) Then Exit Do
    If Timer > (mytim + 15) Then Exit Do
Loop
'Debug.Print Format(Timer - mytim, "0.00")
'Debug.Print 1, mlink0
'Debug.Print 2, mlink
On Error GoTo 0
myWait (0.5)
'GoTo impF
    IE.navigate mlink
myWait (0.2)
    mytim = Timer
    Do While IE.Busy
        DoEvents: If Timer > (mytim + 10) Then Exit Do:
    Loop           'Attesa not busy
    Do While IE.readyState <> 4
        DoEvents: If Timer > (mytim + 30) Then Exit Do
    Loop  'Attesa documento
On Error Resume Next
IE.Quit
Set IE = Nothing
End Sub

Sub ApriYF(ByVal myID As String, Optional mySt As Long = 0)
'
bURL = "https://it.finance.yahoo.com/quote/###.MI/history?p=###"
'Set IE = Nothing
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate Replace(bURL, "###", myID, , , vbTextCompare)
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
If mySt > 0 Then Stop
End Sub
Private Sub myWait(ByVal WSec As Single, Optional ByVal TOut As Single = 10)
'Attende WSec secondi (o il doppio se mezzanotte)
Dim lTim As Single
'
lTim = Timer
Do
    DoEvents
    If Timer > (lTim + WSec) Then Exit Do
    DoEvents
    If Timer < lTim And Timer > WSec Then Exit Do
Loop
End Sub

Codice: Seleziona tutto

 Sub Cancella_Grafici()
    On Error Resume Next
     'Singolo foglio intestato ai grafici
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Chiusura e retta di regressione").Select
ActiveWindow.SelectedSheets.Delete
 
Application.DisplayAlerts = False
Sheets("RSI").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
   
Application.DisplayAlerts = False
Sheets("Chiusura, supporti e resistenze").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
   
Application.DisplayAlerts = False
Sheets("MACD").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Application.DisplayAlerts = False
Sheets("Dettaglio Previsione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Previsione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Chiusura, previsione, S e R").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

End Sub

Codice: Seleziona tutto

 Sub Cancella_bilancio()
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Bilancio").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub

Codice: Seleziona tutto

 Option Explicit

Sub ImportaDati()

Sheets("Dati").Select
Range("A2:BJ1000").Value = ""

 'Application.UseSystemSeparators = False
 '   Application.DecimalSeparator = "."
 '   Application.ThousandsSeparator = ","

    'With _
     '    ActiveSheet.QueryTables.Add _
     '   (Connection:="TEXT;C:\Users\Windows7\Downloads\" & Sheets("Foglio1").Range("A1").Value & ".csv", _
     '   Destination:=Range("$A$4"))
     '  .FieldNames = True
       
       ' .PreserveFormatting = True
     
     '   .SaveData = True
     '   .AdjustColumnWidth = True
     
     '   .TextFilePlatform = 850
    '    .TextFileStartRow = 1
    '    .TextFileParseType = xlDelimited
     
    '    .TextFileCommaDelimiter = True
       
    '    .TextFileColumnDataTypes = Array(xlGeneralFormat, xlGeneralFormat, _
    '        xlGeneralFormat, xlGeneralFormat, _
    '        xlGeneralFormat, xlGeneralFormat)

        '.Refresh
       'End With
       
      Dim Carica_dati As String
      Dim nomequery As String
   

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Text Files", "*.txt,*.csv"
    If .Show = 0 Then Exit Sub
    Carica_dati = "text;" & .SelectedItems(1)
End With
With ActiveSheet.QueryTables.Add(Connection:=Carica_dati, Destination:=Sheets("Dati").Range("A4"))
    nomequery = .Name
    .AdjustColumnWidth = False
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = Array(2, 1)
    .Refresh BackgroundQuery:=False
End With
       
             
       
 'Toglie colonna con valore chiusura aggiustato
       Columns("F:F").Select
       Columns("F:F").Delete
 
   
 'Toglie riga con valore null
 Dim i As Long, lastrow As Long
 lastrow = Range("B" & Rows.Count).End(xlUp).Row
 Sheets("Dati").Select
    For i = lastrow To 1 Step -1
 If LCase(Cells(i, "B").Value) Like "null" Or _
 UCase(Cells(i, "C").Value) Like "null" Or _
 UCase(Cells(i, "D").Value) Like "null" Or _
 UCase(Cells(i, "E").Value) Like "null" Or _
 UCase(Cells(i, "F").Value) Like "null" Then _
 Rows(i).EntireRow.Delete
 Next i
 
 Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:="-", Replacement:="/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 End Sub

Codice: Seleziona tutto

 Sub Scocca()

Sheets("Formule").Select
Range("A1:BJ1000").Value = ""

'Nome titolo
Range("A1").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Quotazioni
Range("A2").Value = "Quotazioni"
Range("A3").Value = "Data"
Range("B3").Value = "Apertura"
Range("C3").Value = "Massimo"
Range("D3").Value = "Minimo"
Range("E3").Value = "Chiusura"
Range("F3").Value = "Volume"
Range("G3").Value = "Data numero"

    Range("A2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    Range("A3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    Range("B3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    Range("C3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
   
    Range("D3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
   
    Range("E3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
   
    Range("F3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
   
    Range("G3").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Supporti e resistenze
Range("H2").Value = "Supporti e resistenze"
Range("H3").Value = "R1"
Range("I3").Value = "S1"
Range("J3").Value = "R2"
Range("K3").Value = "S2"
Range("L3").Value = "R3"
Range("M3").Value = "S3"

Range("H2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Relative Strenght Indicator
Range("N2").Value = "Relative Strenght Indicator"
Range("N3").Value = "Differenze giornaliere"
Range("O3").Value = "Rialzi giornalieri"
Range("P3").Value = "Ribassi giornalieri"
Range("Q3").Value = "SMA 14 Rialzi"
Range("R3").Value = "SMA 14 Ribassi"
Range("S3").Value = "RS"
Range("T3").Value = "RSI-Relative Strenght Index"

Range("N2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'MACD
Range("U2").Value = "MACD"
Range("U3").Value = "EMA12"
Range("V3").Value = "EMA26"
Range("W3").Value = "MACD"
Range("X3").Value = "Signal"
Range("Y3").Value = "Istogramma"

Range("U2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Calcolo Supporti e Resistenze
Range("AA2").Value = "Calcolo Supporti e Resistenze"
Range("AA3").Value = "H"
Range("AA4").Value = "L"
Range("AA5").Value = "C"
Range("AA6").Value = "AP"
Range("AA7").Value = "R1"
Range("AA8").Value = "S1"
Range("AA9").Value = "R2"
Range("AA10").Value = "S2"
Range("AA11").Value = "R3"
Range("AA12").Value = "S3"

Range("AA2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

'Retta di Regressione
Range("AD2").Value = "Retta di Regressione"
Range("AD5").Value = "Regr.lin"
Range("AD6").Value = "Formule"
Range("AE3").Value = "Retta regressione: m*x"
Range("AF3").Value = "Retta regressione: b"
Range("AE4").Value = "Pendenza"
Range("AF4").Value = "Intercetta"
Range("AH3").Value = "Retta di Regressione"

Range("AD2").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

Range("AG2").Value = "EMA20"
Range("AG3").Value = "per previsione"

'Grafici
Range("AJ1").Value = "Grafici"

Range("AJ1").Select
         Selection.Font.Bold = True
        With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With


'Adatta colonne
    Columns("A:AI").Select
    Selection.Columns.AutoFit
    Range("C1").Select
    Columns("C:C").ColumnWidth = 7.29
    Columns("A:A").ColumnWidth = 12.71
    Columns("H:H").ColumnWidth = 2.86
    Columns("N:N").ColumnWidth = 14.71
    Columns("N:N").ColumnWidth = 16.57
    Columns("N:N").ColumnWidth = 18
    Columns("N:N").ColumnWidth = 19.43
    Columns("AD:AD").ColumnWidth = 9
    Columns("AG:AG").ColumnWidth = 13
    Columns("AH:AH").ColumnWidth = 20
   
'Supporti e resistenze con decimali due cifre
    Range("AB3:AB12").Select
    Selection.NumberFormat = "0.00"
    Range("I4:M1000").Select
    Selection.NumberFormat = "0.00"
       
'Retta di regressione con decimali due cifre
    Range("AD9:AD500").Select
    Selection.NumberFormat = "0.00"
 
 'RSI e MACD
    Range("N9:Y500").Select
    Selection.NumberFormat = "0.00"
   
     'Grafico previsione
Range("BA2").Value = "Data"
Range("BB2").Value = "Previsione"
Range("BC2").Value = "R1"
Range("BD2").Value = "S1"
Range("BE2").Value = "R2"
Range("BF2").Value = "S2"
Range("BG2").Value = "R3"
Range("BH2").Value = "S3"

Range("BI2").Value = "Data"
Range("BJ2").Value = "Close"

End Sub

 

Codice: Seleziona tutto

 Sub Formule()
   
     
    Worksheets("Dati").Activate
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Worksheets("Dati").Activate
    Range("B5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Worksheets("Dati").Activate
    Range("C5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    Worksheets("Dati").Activate
    Range("D5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    Worksheets("Dati").Activate
    Range("E5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
   

    Worksheets("Dati").Activate
    Range("F5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Formule").Activate
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False


    Dim lastrow As Long
 
 'Data numero per regressione e previsione
       Worksheets("Formule").Range("G4").FormulaLocal = "=1"
       Worksheets("Formule").Range("G5").FormulaLocal = "=G4+1"
       Range("G5").Copy
       Range("G6").Select
       ActiveSheet.Paste
       Range("G6:G500").FillDown
 
 'Supporti e resistenze
    ' Mi posiziono alla cella AB3
    Range("E4").Select
    ' Individuo l'ultima riga che contiene dati della colonna E
    lastrow = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    ' Aggiungo la formula che fa max da E4 a E<ultimarigapiena>
    'Worksheets("Foglio1").Range("E" & lastrow).FormulaLocal = "=MAX(E4:E" & lastrow - 1 & ")"
    Worksheets("Formule").Range("AB3").FormulaLocal = "=MAX(E4:E" & lastrow - 1 & ")"

    ' Mi posiziono alla cella AB4
    Range("E4").Select
    ' Individuo l'ultima riga che contiene dati della colonna E
    lastrow = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    ' Aggiungo la formula che fa min da E4 a E<ultimarigapiena>
    'Worksheets("Foglio1").Range("E" & lastrow).FormulaLocal = "=MAX(E4:E" & lastrow - 1 & ")"
    Worksheets("Formule").Range("AB4").FormulaLocal = "=MIN(E4:E" & lastrow - 1 & ")"
 
 ' Mi posiziono alla cella AB5
    Range("E4").Select
    ' Individuo l'ultima riga che contiene dati della colonna E
    lastrow = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    ' Si assegna valore ultimo giorno periodo considrato
    Worksheets("Formule").Range("AB5").Value = "=Value(E" & lastrow - 1 & ")"
   

' Mi posiziono alla cella AB6
'Set Range1 = Range("AB3:AB5")
'Totale = Application.WorksheetFunction.Sum(Range1) / 3
'Worksheets("Foglio1").Range("AB6").Value = Totale
Worksheets("Formule").Range("AB6").Value = "=AVERAGE(AB3:AB5)"

'Calcola e incolla formula come valore nella cella AB7
'Worksheets("Foglio1").Range("AB7").FormulaLocal = 2 * Range("AB6") - Range("AB4")

'Calcolo Resistenze e Supporti
'Calcola e inserisce formula nella cella AB7
AB6 = Range("AB6").Value
AB4 = Range("AB4").Value
Worksheets("Formule").Range("AB7").FormulaLocal = "=(2*AB6)-AB4"

AB6 = Range("AB6").Value
AB3 = Range("AB3").Value
Worksheets("Formule").Range("AB8").FormulaLocal = "=(2*AB6)-AB3"

Worksheets("Formule").Range("AB9").FormulaLocal = "=AB6+(AB3-AB4)"

Worksheets("Formule").Range("AB10").FormulaLocal = "=AB6-(AB3-AB4)"

Worksheets("Formule").Range("AB11").FormulaLocal = "=AB3+(2*(AB6-AB4))"

Worksheets("Formule").Range("AB12").FormulaLocal = "=AB4-2*(AB3-AB6)"

Worksheets("Formule").Range("H4").Value = Worksheets("Formule").Range("AB7").Value

   'Mi posiziono alla cella H4
    Range("H4").Select
   
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("H4").Value = "=(AB" & lastrow - 6 & ")"
       ActiveCell.FormulaR1C1 = "=(R7C28)"
       Range("H4").Copy
       Range("H5").Select
       ActiveSheet.Paste
       Range("H5:H500").FillDown
       
    'Mi posiziono alla cella I4
    Range("I4").Select
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("I4").Value = "=(AB" & lastrow - 5 & ")"
    ActiveCell.FormulaR1C1 = "=(R8C28)"
       Range("I4").Copy
       Range("I5").Select
       ActiveSheet.Paste
       Range("I5:I500").FillDown
   
       'Mi posiziono alla cella J4
    Range("J4").Select
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("J4").Value = "=(AB" & lastrow - 4 & ")"
    ActiveCell.FormulaR1C1 = "=(R9C28)"
    Range("J4").Copy
       Range("J5").Select
       ActiveSheet.Paste
       Range("J5:J500").FillDown
   
          'Mi posiziono alla cella K4
    Range("K4").Select
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("K4").Value = "=(AB" & lastrow - 3 & ")"
    ActiveCell.FormulaR1C1 = "=(R10C28)"
    Range("K4").Copy
       Range("K5").Select
       ActiveSheet.Paste
       Range("K5:K500").FillDown
   
    'Mi posiziono alla cella L4
    Range("L4").Select
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("L4").Value = "=(AB" & lastrow - 2 & ")"
      ActiveCell.FormulaR1C1 = "=(R11C28)"
       Range("L4").Copy
       Range("L5").Select
       ActiveSheet.Paste
       Range("L5:L500").FillDown
     
     'Mi posiziono alla cella M4
    Range("M4").Select
    lastrow = Cells(Rows.Count, 28).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("M4").Value = "=(AB" & lastrow - 1 & ")"
    ActiveCell.FormulaR1C1 = "=(R12C28)"
       Range("M4").Copy
       Range("M5").Select
       ActiveSheet.Paste
       Range("M5:M500").FillDown
       
      'Relative Strenght Indicator
      'Differenze giornaliere
       Worksheets("Formule").Range("N5").FormulaLocal = "=E5-E4"
       Range("N5").Copy
       Range("N6").Select
       ActiveSheet.Paste
       Range("N6:N500").FillDown
       
       'Rialzi giornalieri
       Worksheets("Formule").Range("O5").FormulaLocal = "=SE(N5>=0;N5;0)"
       Range("O5").Copy
       Range("O6").Select
       ActiveSheet.Paste
       Range("O6:O500").FillDown
       
       'Ribassi giornalieri
       Worksheets("Formule").Range("P5").FormulaLocal = "=SE(N5<0;ASS(N5);0)"
       Range("P5").Copy
       Range("P6").Select
       ActiveSheet.Paste
       Range("P6:P500").FillDown
       
       'SMA 14 Rialzi
       Worksheets("Formule").Range("Q18").FormulaLocal = "=MEDIA(O5:O18)"
       Range("Q18").Copy
       Range("Q19").Select
       ActiveSheet.Paste
       Range("Q19:Q500").FillDown
       
       'SMA 14 Ribassi
       Worksheets("Formule").Range("R18").FormulaLocal = "=MEDIA(P5:P18)"
       Range("R18").Copy
       Range("R19").Select
       ActiveSheet.Paste
       Range("R19:R500").FillDown

       'RS
       Worksheets("Formule").Range("S18").FormulaLocal = "=SE(R18=0;0;Q18/R18)"
       Range("S18").Copy
       Range("S19").Select
       ActiveSheet.Paste
       Range("S19:S500").FillDown
       
       'RSI-Relative Strenght Index
       Worksheets("Formule").Range("T18").FormulaLocal = "=100-(100/(1+S18))"
       Range("T18").Copy
       Range("T19").Select
       ActiveSheet.Paste
       Range("T19:T500").FillDown
       
       'MACD
       'EMA12
       Worksheets("Formule").Range("U15").FormulaLocal = "=MEDIA(E4:E15)"
       Range("U15").Copy
       Range("U16").Select
       ActiveSheet.Paste
       Range("U16:U500").FillDown
       
       'EMA26
       Worksheets("Formule").Range("V29").FormulaLocal = "=MEDIA(E4:E29)"
       Range("V29").Copy
       Range("V30").Select
       ActiveSheet.Paste
       Range("V30:V500").FillDown
         
       'MACD
       Worksheets("Formule").Range("W29").FormulaLocal = "=(+U29-V29)"
       Range("W29").Copy
       Range("W30").Select
       ActiveSheet.Paste
       Range("W30:W500").FillDown
       
       'Signal
       Worksheets("Formule").Range("X37").FormulaLocal = "=MEDIA(W29:W37)"
       Range("X37").Copy
       Range("X38").Select
       ActiveSheet.Paste
       Range("X38:X500").FillDown
 
       'Istogramma
       Worksheets("Formule").Range("Y37").FormulaLocal = "=(+W37-X37)"
       Range("Y37").Copy
       Range("Y38").Select
       ActiveSheet.Paste
       Range("Y38:Y500").FillDown
                         
    'Retta di regressione
    'Pendenza e intercetta
    Range("AE6").Select
    ActiveCell.FormulaR1C1 = _
        "=SLOPE(R[-2]C[-26]:R[252]C[-26],R[-2]C[-24]:R[252]C[-24])"
    Range("AF6").Select
    ActiveCell.FormulaR1C1 = _
        "=INTERCEPT(R[-2]C[-27]:R[252]C[-27],R[-2]C[-25]:R[252]C[-25])"

    'Regressione funzione regr.lin
    Range("AE5:AF5").Select
     Selection.FormulaArray = _
        "=LINEST(R[-1]C[-26]:R[253]C[-26],R[-1]C[-24]:R[253]C[-24],TRUE,FALSE)"
   
    'Valori retta di regressione su quotazione chiusura Y e data numero X
    Range("AH4").Select
    ActiveCell.FormulaR1C1 = "=R5C31*RC[-27]+R5C32"
    Range("AH4").Copy
    Range("AH5").Select
    ActiveSheet.Paste
    Range("AH5:AH500").FillDown
                         
    'Media mobile 20 giorni per calcolo valori previsione
    Worksheets("Formule").Range("AG22").FormulaLocal = "=MEDIA(AH3:AH22)"
    Range("AG22").Copy
    Range("AG23").Select
    ActiveSheet.Paste
    Range("AG23:AG500").FillDown

End Sub

Codice: Seleziona tutto

 Sub Cancella_righe_vuote_dopo_copia_incolla_formule()

 'Cancella righe vuote dopo copia-incolla formule

 Dim i As Long, lastrow As Long
 lastrow = Range("H" & Rows.Count).End(xlUp).Row
 Sheets("Formule").Select

 For i = lastrow To 1 Step -1
 If LCase(Cells(i, "A").Value) Like "" And _
 UCase(Cells(i, "B").Value) Like "" And _
 UCase(Cells(i, "C").Value) Like "" And _
 UCase(Cells(i, "D").Value) Like "" And _
 UCase(Cells(i, "E").Value) Like "" And _
 UCase(Cells(i, "F").Value) Like "" Then _
 Rows(i).EntireRow.Delete
 Next i
 End Sub

Codice: Seleziona tutto

 Sub Grafici()
         
Sheets("Formule").Select

'Cancella grafici sul foglio Formule
    xGrafico = Sheets("Formule").ChartObjects.Count
    If xGrafico > 0 Then
    Sheets("Formule").ChartObjects.Delete
    End If

   'Seleziona dati per grafico chiusura e regressione
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AN3").Select
    ActiveSheet.Paste
   
    Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Range("AO3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
   
    Range("AH3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Range("AP3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
    'Nasconde dati
    Range("AN3:AP3").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With

    'Crea grafico Chiusura e regressione
    Worksheets("Formule").Activate
    Range("AN3:AP258").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!$AN$3:$AP$256")
   
   
       
    'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 6
    ActiveChart.Axes(xlValue).MaximumScale = 5.5
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
   

             
   'Seleziona dati per grafico chiusura , supporti e resistenze
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AQ3").Select
    ActiveSheet.Paste
   
    Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Range("AR3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
         
    Range("H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AS3").Select
    ActiveSheet.Paste

    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AT3").Select
    ActiveSheet.Paste
   
    Range("J3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AU3").Select
    ActiveSheet.Paste
   
    Range("K3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AV3").Select
    ActiveSheet.Paste

    Range("L3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AW3").Select
    ActiveSheet.Paste
   
    Range("M3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AX3").Select
    ActiveSheet.Paste
   
       
    'Crea grafico chiusura , supporti e resistenze
    Worksheets("Formule").Activate
    Range("AQ3:AR258").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!$AQ$3:$AX$256")

'Inserisce titolo
 ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
   ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
   
   'Nasconde dati
   Range("AQ3:AX3").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With

   
   
    'Seleziona dati per grafico RSI-Relative Strenght Index
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AY3").Select
    ActiveSheet.Paste

    Range("T3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AZ3").Select
    ActiveSheet.Paste
   
    Range("T18").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AZ18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    'Crea grafico RSI-Relative Strenght Index
    Worksheets("Formule").Activate
    Range("AY3:AZ258").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!$AY$3:$AZ$256")

 
    'Formatta grafico
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102


      ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 10
    ActiveChart.Axes(xlValue).MinimumScale = 10
    ActiveChart.Axes(xlValue).MaximumScale = 15
    ActiveChart.Axes(xlValue).MaximumScale = 90
  ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "RSI-Relative Strenght Index sulla chusura" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "RSI-Relative Strenght Index" & " " & Sheets("Dati").Range("A1").Value
   
 'Nasconde dati
   Range("AY3:AZ258").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
   
    'Seleziona dati per grafico MACD
    Range("A3").Select
  Range(Selection, Selection.End(xlDown)).Select
 Selection.Copy
 Range("AJ3").Select
 ActiveSheet.Paste
   
     Range("W3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AK3").Select
    ActiveSheet.Paste
   
    Range("W28").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AK28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("X3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AL3").Select
    ActiveSheet.Paste
   
    Range("X36").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AL37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("Y3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AM3").Select
    ActiveSheet.Paste
   
    Range("Y37").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("AM37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
       
     
   
    'Crea grafico MACD
    Worksheets("Formule").Activate
    Range("AJ3:AM258").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!$AJ$3:$AM$256")
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ChartType = xlColumnClustered
 
    'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.2
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "MACD" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "MACD" & " " & Sheets("Dati").Range("A1").Value
   
 'Nasconde dati
   Range("AK2:AM258").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
   
 
'Seleziona dati per grafico Dettaglio Previsione
    Sheets("Formule").Select
    Range("A217:A247").Select
    Selection.Copy
    Range("BI3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   
    Sheets("Formule").Select
    Range("E217:E247").Select
    Selection.Copy
    Range("BJ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
     
      'Nasconde dati
    Range("BI2:BJ33").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
   'Crea grafico Dettaglio Previsione
    Worksheets("Formule").Activate
    Range("BI3:BJ32").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!BI3:BJ39")
   
   
       
    'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MaximumScale = 4.9
    ActiveChart.Axes(xlValue).MaximumScale = 5.3
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
   
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
   
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

Codice: Seleziona tutto

 
Option Explicit

Public Sub Grafico_chiusura_Regressione_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Chiusura e retta di regressione").Select
ActiveWindow.SelectedSheets.Delete


Application.DisplayAlerts = True
Elabora_Grafico:
  Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "Chiusura e retta di regressione"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets("Formule").Range("AN3:AP256")
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
  End With
 
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 6
    ActiveChart.Axes(xlValue).MaximumScale = 5.5
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

[EnricoBanco]

Codice: Seleziona tutto

 Public Sub Grafico_Relative_Strenght_Indicator_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("RSI").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
  Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "RSI"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets("Formule").Range("AY3:AZ256")
    .HasTitle = True
    .ChartTitle.Text = "=Sheet1!R3C1"
  End With
 
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 15
    ActiveChart.Axes(xlValue).MaximumScale = 90
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Relative Strenght Indicator" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Relative Strenght Indicator" & " " & Sheets("Dati").Range("A1").Value
 End Sub

Codice: Seleziona tutto

 Sub Grafico_Chiusura_Supporti_e_Resistenze_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Chiusura, supporti e resistenze").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
  Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "Chiusura, supporti e resistenze"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets("Formule").Range("$AQ$3:$AX$256")
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
  End With
 
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 3
    ActiveChart.Axes(xlValue).MaximumScale = 8
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

Codice: Seleziona tutto

 Sub Grafico_MACD_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("MACD").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "MACD"
    .ChartType = xlLine
   
    .SetSourceData Source:=Sheets("Formule").Range("$AJ$3:$AM$256")
    .HasTitle = True
    .ChartTitle.Text = "=Sheet1!R3C1"
      ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ChartType = xlColumnClustered
  End With
 
    'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.2
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "MACD" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "MACD" & " " & Sheets("Dati").Range("A1").Value
   End Sub

Codice: Seleziona tutto

 Sub Scarica_Bilancio_Enel_Tabella_su_excel()
'Yahoo Finance
'Funziona ma non riporta in excel alcuni dati tra cui il nome dell'azione
' Scarica dati da sito web tramite input box indicando la stringa tipo
'FCA.MI/history?p=FCA.MI
'FCA.MI è la sigla del titolo
'Quotazioni dati storici titolo

'http://www.evaluation.it
'Funziona. Elenco aziende consultabile sul sito: http://www.evaluation.it/aziende/bilanci-aziende/
'Inserire nell'inputbox: nome/
   
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Bilancio").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

    Dim oSh As Worksheet
    'Set oSh = ActiveSheet
    Set oSh = ActiveWorkbook.Worksheets.Add
    oSh.Name = "Bilancio"
   
    With oSh.QueryTables.Add( _
       "URL;http://www.evaluation.it/aziende/bilanci-aziende/[""Immettere URL""]", oSh.Range("A1"))
        On Error Resume Next
        .Refresh BackgroundQuery:=False
        MsgBox .Parameters.Count
       With .Parameters(1)
           .SetParam xlRange, oSh.Range("AR300")
          .RefreshOnChange = True
          Cells(1, 7) = "Fonte: http://www.evaluation.it/" & " " & Sheets("Controlli").Range("J2").Value
          QueryTables.Delete
       End With
    End With
End Sub

Codice: Seleziona tutto

 Sub Scarica_Bilancio_Enel_File()

'Funziona con il nome file con lo spazio messo %20 nella URL. Cancella, Scarica il file xlsx in modo dinamico

Sheets("Controlli").Select
If Range("J6").Value = "" Then
MsgBox "Nella cella J6 del foglio Controlli inserire nome file da scaricare dal sito come indicato nella URL. Nella cella J8 inserire il percorso completo web del file. Nella cella J10 inserire la directory di scarico file bilancio"
Exit Sub
Else: GoTo Continua

'Relazione%20finanziaria%20annuale%202016.pdf
'https://www.enel.com/content/dam/enel-com/governance_pdf/reports/bilanci-annuali/2016/

Continua:
On Error Resume Next
Kill Sheets("Controlli").Range("J10").Value & Sheets("Controlli").Range("J6").Value & ".pdf"

On Error GoTo 0

Dim myURL As String
Dim WinHttpReq As Object
myURL = Sheets("Controlli").Range("J8").Value

Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile Sheets("Controlli").Range("J10").Value & Sheets("Controlli").Range("J6").Value & ".pdf"
    oStream.Close
End If
 'Workbooks.Open Filename:=Sheets("Controlli").Range("J10").Value & Sheets("Controlli").Range("J6").Value & ".pdf"
End If
End Sub

Codice: Seleziona tutto

 Sub Colonna_data_per_simulazione()

Dim i As Integer
 
   Sheets("Formule").Select
   
     
   If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
   
   For i = 1 To Worksheets("Controlli").Range("J12").Value
     
    'Incremento colonna data A per i dati di simulazione
   
    Range("A2").Select
    ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    Worksheets("Formule").Range("A" & ultimariga).Select
   
    Worksheets("Formule").Range("A" & ultimariga).Copy
    Worksheets("Formule").Range("A" & ultimariga).FillDown
    Worksheets("Formule").Range("A" & ultimariga).Value = Worksheets("Formule").Range("A" & ultimariga).Value + 1
   

    'Imposta i giorni della settimana in colonna B
    ultimariga = Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("B" & ultimariga).Select
    Worksheets("Formule").Range("B" & ultimariga).FormulaLocal = "=GIORNO.SETTIMANA(RC[-1])- 1 "
    Selection.NumberFormat = "#,##0.0"
    Selection.NumberFormat = "#,##0"
Next i

 Dim g As Long, lastrow As Long
 lastrow = Range("B" & Rows.Count).End(xlUp).Row
 Sheets("Formule").Select
 For g = lastrow To 1 Step -1
 If LCase(Cells(g, "B").Value) Like "0" Or _
 UCase(Cells(g, "B").Value) Like "6" Then _
 Rows(g).EntireRow.Delete
 Next g

Dim d As Long, lastrowd As Long
 lastrowd = Range("A" & Rows.Count).End(xlUp).Row
 Sheets("Formule").Select

 For d = lastrowd To 1 Step -1
 If LCase(Cells(d, "A").Value) Like "02/06/2017" Or _
 UCase(Cells(d, "A").Value) Like "29/06/2017" Or _
 UCase(Cells(d, "A").Value) Like "15/08/2017" Or _
 UCase(Cells(d, "A").Value) Like "01/11/2017" Or _
 UCase(Cells(d, "A").Value) Like "08/12/2017" Or _
 UCase(Cells(d, "A").Value) Like "25/12/2017" Or _
 UCase(Cells(d, "A").Value) Like "26/12/2017" Or _
 UCase(Cells(d, "A").Value) Like "31/12/2017" Or _
 UCase(Cells(d, "A").Value) Like "01/01/2018" Or _
 UCase(Cells(d, "A").Value) Like "06/01/2018" Then _
 Rows(d).EntireRow.Delete
 Next d
 
'Inserimento data
   
    Dim MiaData
   
    Dim valinserito_d1 As String
    Dim valconvertito_d1 As String
    valinserito_d1 = Format(MiaData, "dd/mm/yyyy")
    valconvertito_d1 = Format(MiaData, "dd/mm/yyyy")
   
    valinserito_d1 = InputBox("Inserisci Data")
    valconvertito_d1 = Val(valinserito_d1)
    If valconvertito_d1 = "" Then
    MsgBox ("Nessuna data inserita")
   
    Else
    Worksheets("Formule").Activate
    End If
 
 'Inserimento data
    Dim valinserito_d2 As String
    Dim valconvertito_d2 As String
    valinserito_d2 = Format(MiaData, "dd/mm/yyyy")
    valconvertito_d2 = Format(MiaData, "dd/mm/yyyy")
    valinserito_d2 = InputBox("Inserisci Data")
    valconvertito_d2 = Val(valinserito_d2)
    If valconvertito_d2 = "" Then
    MsgBox ("Nessuna data inserita")
   
    Else
    MsgBox ("Data inserita" & " " & valinserito_d2)
    End If

 'Toglie righe con criterio data
 Dim k As Long, lastrowe As Long
 lastrowe = Range("A" & Rows.Count).End(xlUp).Row
 Sheets("Formule").Select

 For k = lastrowe To 1 Step -1
 If LCase(Cells(k, "A").Value) = valinserito_d1 Or _
 UCase(Cells(k, "A").Value) = valinserito_d2 Then _
 Rows(k).EntireRow.Delete
 Next k
End If
End Sub

Codice: Seleziona tutto

 Sub Data_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For d = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("G3").Select
    ultimariga = Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("G" & ultimariga).Select
    Worksheets("Formule").Range("G" & ultimariga).Copy
    Worksheets("Formule").Range("G" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("G" & ultimariga).FillDown
   
   Next d
   End If
End Sub

Codice: Seleziona tutto

 Sub Regressione_per_calcolo_dati_di_previsione()

 Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
   
   For R = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in AH della regressione per calcolo dati di previsione.
    Range("AH3").Select
    ultimariga = Cells(Rows.Count, 34).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("AH" & ultimariga).Select
    Worksheets("Formule").Range("AH" & ultimariga).Copy
    Worksheets("Formule").Range("AH" & ultimariga).FillDown
    ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("AH" & ultimariga).FillDown
    Next R
      End If
     End Sub

Codice: Seleziona tutto

 Sub Media_mobile_a_20_giorni()

 
 Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
   
   
   For m = 1 To Worksheets("Controlli").Range("J12").Value
         'Incremento colonna dati in AG della media mobile a 20 giorni per calcolo dati di previsione.
    Range("AG22").Select
    ultimariga = Cells(Rows.Count, 33).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("AG" & ultimariga).Select
    Worksheets("Formule").Range("AG" & ultimariga).Copy
    Worksheets("Formule").Range("AG" & ultimariga).FillDown
    ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("AG" & ultimariga).FillDown
   Next m
   End If
End Sub

Codice: Seleziona tutto

 Sub Calcola_dati_previsione()
 
 'Calcola dati previsione in colonna E
 
 
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
   Sheets("Formule").Select
    'Meno uno -1 perchè calcola in modo con corretto la cella successiva al numero indicato in L1
    For V = lastrow To Worksheets("Controlli").Range("J12").Value - 1
        'For i = 1 To 100
    Range("E4").Select
    ' Individuo l'ultima riga che contiene dati della colonna E
    lastrow = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    'For i = lastrow To lastrow
    'Worksheets("Foglio1").Range("E" & lastrow).FormulaLocal = "=MEDIA(AG" & i & ":AH" & i & ")* (1 - L1)"
     Worksheets("Formule").Range("E" & lastrow).FormulaLocal = "=MEDIA(RC[28]:RC[29])*(1-           Controlli!R14C10)"
       'Worksheets("Formule").Range("E" & lastrow).FormulaLocal = "=MEDIA(RC[28]:RC[29])*(1-R1C12)"
      'Worksheets("Foglio1").Range("E" & lastrow).FillDown
      'ActiveCell.FormulaR1C1 =
      'lastrow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    'Worksheets("Foglio1").Range("E" & lastrow).FillDown
   ' Next i
    Next V
   '
           End If
     End Sub

 

Codice: Seleziona tutto

 Sub R1_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For A = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("H" & ultimariga).Select
    Worksheets("Formule").Range("H" & ultimariga).Copy
    Worksheets("Formule").Range("H" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("H" & ultimariga).FillDown
   
   Next A
   End If
End Sub

Codice: Seleziona tutto

 Sub S1_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For B = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("I" & ultimariga).Select
    Worksheets("Formule").Range("I" & ultimariga).Copy
    Worksheets("Formule").Range("I" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("I" & ultimariga).FillDown
   
   Next B
   End If
End Sub

 

Codice: Seleziona tutto

 Sub R2_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For d = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("J" & ultimariga).Select
    Worksheets("Formule").Range("J" & ultimariga).Copy
    Worksheets("Formule").Range("J" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("J" & ultimariga).FillDown
   
   Next d
   End If
End Sub

Codice: Seleziona tutto

 Sub S2_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For d = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("K" & ultimariga).Select
    Worksheets("Formule").Range("K" & ultimariga).Copy
    Worksheets("Formule").Range("K" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("K" & ultimariga).FillDown
   
   Next d
   End If
End Sub

Codice: Seleziona tutto

 Sub R3_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For e = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 12).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("L" & ultimariga).Select
    Worksheets("Formule").Range("L" & ultimariga).Copy
    Worksheets("Formule").Range("L" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("L" & ultimariga).FillDown
   Next e
   End If
End Sub

 

Codice: Seleziona tutto

 Sub S3_per_calcolo_dati_di_previsione()
 
Sheets("Formule").Select
 
 'Dim i As Long
'    For i = 1 To 100
 '       Range("A1").Cells(i, 1).FormulaLocal = "=SOMMA(B" & i & ":B" & i + 1 & ")"
  '  Next i
If Worksheets("Controlli").Range("J12").Value = "" Then
   
   MsgBox "Inserire numero giorni per elaborazione valori di previsione"
   Exit Sub
   
   Else
    For d = 1 To Worksheets("Controlli").Range("J12").Value
    'Incremento colonna dati in G numero data per calcolo dati di previsione.
    Range("H3").Select
    ultimariga = Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Row
   
    Worksheets("Formule").Range("M" & ultimariga).Select
    Worksheets("Formule").Range("M" & ultimariga).Copy
    Worksheets("Formule").Range("M" & ultimariga).FillDown
    'ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("Formule").Range("M" & ultimariga).FillDown
   Next d
   End If
End Sub

 

Codice: Seleziona tutto

 Sub Cancella_righe_dopo_dati_previsione()
        'Cancella righe con data non valorizzata dopo elaborazone dati previsione
        Sheets("Formule").Select
    Range("A2").Select
    ultimariga = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Range(Rows(ultimariga), Rows(1000)).Select
    Selection.Delete
    End Sub

Codice: Seleziona tutto

 Sub Grafico_previsione()

Worksheets("Formule").Activate

    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BA3").Select
    ActiveSheet.Paste

    Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BB3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("E3").Select
    Application.CutCopyMode = False
         
    Range("H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BC3").Select
    ActiveSheet.Paste

    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BD3").Select
    ActiveSheet.Paste
   
    Range("J3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BE3").Select
    ActiveSheet.Paste
   
    Range("K3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BF3").Select
    ActiveSheet.Paste

    Range("L3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BG3").Select
    ActiveSheet.Paste
   
    Range("M3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BH3").Select
    ActiveSheet.Paste
   
       
    'Crea grafico Chiusura, previsione, supporti e resistenze
    Worksheets("Formule").Activate
    Range("BA2:BH248").Select
    'ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.Shapes.AddChart(xlLine, width:=1000, Height:=400).Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Formule!$BA$2:$BH$266")

'Inserisce titolo
 ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
   ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
   
   'Nasconde dati
   Range("BA2:BH253").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End Sub

Codice: Seleziona tutto

 Sub Grafico_previsione_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Previsione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "Previsione"
    .ChartType = xlLine
   
    .SetSourceData Source:=Sheets("Formule").Range("$BA$2:$BH$266")
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
   
     ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 3
    ActiveChart.Axes(xlValue).MaximumScale = 8
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
       
  End With
   
'Inserisce titolo
 ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
   ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
       
End Sub

Codice: Seleziona tutto

 Sub Grafico_Dettaglio_Previsione_Foglio()
   
On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Dettaglio Previsione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


Elabora_Grafico:
  Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
    .Name = "Dettaglio Previsione"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets("Formule").Range("BI2:BJ39")
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
  End With
 
       
     'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MaximumScale = 4.5
    ActiveChart.Axes(xlValue).MaximumScale = 5.4
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
   
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
   
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

Codice: Seleziona tutto

 Sub SelRange_Dettaglio_Previsione_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Dettaglio Previsione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


Elabora_Grafico:

Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "Dettaglio Previsione"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
    Next
  End With
 
       
     'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MinimumScale = 4.9
    ActiveChart.Axes(xlValue).MaximumScale = 4.5
    ActiveChart.Axes(xlValue).MaximumScale = 5.4
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Dettaglio Previsione" & " " & Sheets("Dati").Range("A1").Value
   
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
   
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
'Next
End Sub

Codice: Seleziona tutto

 Sub SelRange_Grafico_MACD_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("MACD").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


Elabora_Grafico:

Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "MACD"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
      ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ChartType = xlColumnClustered
    Next
  End With
 
    'Formatta grafico
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.1
    ActiveChart.Axes(xlValue).MaximumScale = 0.2
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "MACD" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "MACD" & " " & Sheets("Dati").Range("A1").Value
   
    'Next
 End Sub

Codice: Seleziona tutto

 Option Explicit

Sub SelRange_Grafico_Chiusura_Regressione_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Chiusura e retta di regressione").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
 
  Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "Chiusura e retta di regressione"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
    Next
  End With
 
  'Formatta grafico
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 6
    ActiveChart.Axes(xlValue).MaximumScale = 5.5
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura e retta regressione" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

Codice: Seleziona tutto

 Public Sub SelRange_Grafico_Relative_Strenght_Indicator_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("RSI").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
  Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "Relative Strenght Indicator"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
    Next
  End With

 
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 15
    ActiveChart.Axes(xlValue).MaximumScale = 90
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Relative Strenght Indicator" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Relative Strenght Indicator" & " " & Sheets("Dati").Range("A1").Value
 End Sub

Codice: Seleziona tutto

 Sub SelRange_Grafico_Chiusura_Supporti_e_Resistenze_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Chiusura, supporti e resistenze").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Elabora_Grafico:
 
  Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "Chiusura, supporti e resistenze"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
    Next
  End With

 
  ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MinimumScale = 2
    ActiveChart.Axes(xlValue).MaximumScale = 3
    ActiveChart.Axes(xlValue).MaximumScale = 8
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 58
    Selection.Top = 106.975
End Sub

Codice: Seleziona tutto

 Sub SelRange_Chiusura_previsione_supporti_e_resistenze_Foglio()

On Error GoTo Elabora_Grafico
Application.DisplayAlerts = False
Sheets("Chiusura, previsione, S e R").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True


Elabora_Grafico:

Sheets("Formule").Activate
Dim SelRange As Range
Dim Cell
Set SelRange = Selection

'For Each Cell In SelRange
   
    Dim aChart As Chart

  Set aChart = Charts.Add
  With aChart
  'Set SelRange = Selection
    For Each Cell In SelRange
    .Name = "Chiusura, previsione, S e R"
    .ChartType = xlLine
    .SetSourceData Source:=SelRange
    .HasTitle = True
    '.ChartTitle.Text = "=Sheet1!R3C1"
    Next
  End With

On Error Resume Next
'Inserisce titolo
 ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Chiusura, previsione, supporti e resistenze" & " " & Sheets("Dati").Range("A1").Value
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 31).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
   ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = 2
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 3
    End With
    With Selection
        .Type = xlPolynomial
        .Order = 4
    End With
    Selection.DisplayEquation = True
    Selection.DisplayRSquared = True
    ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Left = 51.236
    Selection.Top = 108.102
       
End Sub