Siteden Güncel Bakır ve Dolar Bilgilerini Excel'e Aktarma

[ariturka]

Merhaba.
Excel'de kendim bir tablo oluşturdum ve bu tablo üzerinde LME (Bakır) ve Dolar bilgileri mevcuttur. Ancak LME ve Dolar sürekli değişken olduğundan bunu tablo üzerinde anlık olarak görmek istiyorum. LME sitesinin linki ve resmi ekte sunulmuştur. Güncel Dolar bilgileri sizin bildiğiniz bir site olabilir.

LME
http://www.jpmorganmetals.com/Commodities.asp

 

[ariturka]

UpUpUp... UpUpUp...

 

[ariturka]

UpUpUp... UpUpUp...

 

[cems]

Boş bir sayfa açıp şu sol üste bir tuş ekleyin ve tuşa çift tıklayarak açılan Vbe kısmına şu kodları yerleştirin :

Sub Düğme1_Tıklat()
Sheets("Sayfa1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.jpmorganmetals.com/Commodities.asp", Destination:=Range( _
        "$A$4"))
        .Name = "Commodities_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.RefreshAll
    Range("A1").Select
End Sub

Sayfa düzenlemenizi bu değişken alanı belirledikten sonra yapmak daha doğru. Dosya her açılışında yeniden sorgular ya da tuş ile her istediğinizde sorgu yapabilirsiniz. Kendi haline bırakırsanız da 10 dakikada 1 sorgular ( eğer gerek varsa ).

 

[Zeki Gürsoy]

İnternetten hızlı veri alma için aşağıdaki gibi kullanın.

Sub Veri_Al()
    With CreateObject("msxml2.xmlhttp")
        .Open "get", "http://www.jpmorganmetals.com/Commodities.asp", False
        .send
        Set doc = CreateObject("htmlfile")
        doc.write (.responseText)
        Set tables = doc.getElementsByTagName("Table")
        For Each t In tables
            If LCase(t.className) = "prices" Then
                MsgBox t.Rows(1).Cells(2).innerText
                Exit For
            End If
        Next
        Set HTML = Nothing
    End With
End Sub

 

[ariturka]

teşekkür ederim ustat çok işime yarayacak...