Apache OpenOffice: forum della comunità

Codice: Seleziona tutto

Sub DataDownload()                 'la macro serve per scaricare le quotazioni di borsa da Yahoo finanza
    Dim Sh As Worksheet, xNazwa As Object
    Dim xConect As Object
    Dim QuerySheet As Worksheet         'credo ci sia un primo problema qua
    Dim SettingsSheet As Worksheet      ' e un altro problema qua, poi gli altri non so...
    Dim EndDate As Date
    Dim StartDate As Date
    Dim SYMBOL As String
    Dim qurl As String
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Workbooks("stockbacktest.xls").Worksheets("data").Range("a1:g9999").ClearContents
    Set SettingsSheet = Workbooks("stockbacktest.xls").Worksheets("Settings")
        StartDate = SettingsSheet.Range("B2").Value 'Fa riferimento ad una cella dove è inserita 
                                     ' la data di inizio, per comodità si può inserire =OGGI()-200
        EndDate = SettingsSheet.Range("B3").Value 'Fa riferimento ad una cella dove è inserita 
                                     ' la data di fine, per comodità si può inserire =OGGI()
        SYMBOL = SettingsSheet.Range("B1")           'Fa riferimento al titolo azionario da cercare, 
        'ad esempio nella cella si può scrivere GOOG per google o F.MI per Fiat per fare delle prove
        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & SYMBOL
        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
            Day(EndDate) & "&f=" & Year(EndDate) & "&g=d&q=q&y=0&z=" & _
            SYMBOL & "&x=.csv"
QueryQuote:
            Set QuerySheet = Workbooks("stockbacktest.xls").Worksheets("data")
             
             With QuerySheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=QuerySheet.Range("a1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                On Error Resume Next
                .Refresh BackgroundQuery:=False
                'Most recent data always at 145
                'Range("x146:x200").ClearContents
                .SaveData = True
           Workbooks("stockbacktest.xls").Worksheets("data").Range("a1").CurrentRegion.TextToColumns Destination:=Workbooks("stockbacktest.xls").Worksheets("data").Range("a1"), DataType:=xlDelimited, _
           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
           Semicolon:=False, Comma:=True, Space:=False, Other:=False
           Workbooks("stockbacktest.xls").Worksheets("data").Range(Range("a1"), Range("a1").End(xlDown)).NumberFormat = "mmm d/yy"
           Workbooks("stockbacktest.xls").Worksheets("data").Range(Range("b1"), Range("e1").End(xlDown)).NumberFormat = "0.00"
           Workbooks("stockbacktest.xls").Worksheets("data").Range(Range("f1"), Range("f1").End(xlDown)).NumberFormat = "0,000"
           Workbooks("stockbacktest.xls").Worksheets("data").Range("A1:g65536").Sort Key1:=Workbooks("stockbacktest.xls").Worksheets("data").Range("a1"), Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
           End With
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
'clear data connections
For Each xConect In ActiveWorkbook.Connections
If UCase(xConect.Name) Like "*" Then xConect.Delete
Next xConect
For Each Sh In ActiveWorkbook.Worksheets
For Each xNazwa In Sh.Names
xNazwa.Delete
Next xNazwa
Next Sh
End Sub