• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Yardım Webden belirli döviz kurlarını çekme

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
En iyi yanıt
0
Puanları
1
Yaş
31
Konum
Eskişehir
Ad Soyad
Ali Akgün

Butona basıldığında sırasıyla : Dolar, Euro, İngiliz Sterlini, Japon Yeni, Kanada Doları, İsveç Kronu döviz bilgilerini yukarıdaki siteden "kurlar" sayfasına aldıktan sonra sırasıyla ayrı ayrı Excel sayfalarına yazan makro kodları gerekiyor. Uğraştım ama bir sonuca varamadım. Yardım edebilecek arkadaşlara şimdiden çok teşekkür ederim. Dosya ektedir.
 

Ekli dosyalar

  • Kurlar.rar
    18.4 KB · Görüntüleme: 17

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
128
En iyi yanıt
4
Puanları
28
Yaş
63
Konum
Emekli
Sayın PLINT in kodları.
Kendinize göre uyarlayınız.:cool:
Kod:
Dim s As Long
Dim ie, t
[A2:E10] = ""
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "http://www.tcmb.gov.tr/kurlar/today.xml"
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop
Set st = ie.document.getElementById("kurlarContainer")
On Error Resume Next
For Each t In st.getElementsByTagName("*")
If Trim(t.Children(0).innertext) = "USD/TRY" Or Trim(t.Children(0).innertext) = "EUR/TRY" _
Or Trim(t.Children(0).innertext) = "GBP/TRY" Then
s = Cells(Rows.Count, 1).End(3).Row + 1
Cells(s, 1) = t.Children(0).innertext
Cells(s, 2) = t.Children(3).innertext
Cells(s, 3) = t.Children(4).innertext
Cells(s, 4) = t.Children(5).innertext
Cells(s, 5) = t.Children(6).innertext
End If
Next
Set st = Nothing
ie.Quit
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
En iyi yanıt
0
Puanları
1
Yaş
31
Konum
Eskişehir
Ad Soyad
Ali Akgün
Sn.Evren hocam 4. ve 5. kuru çekerken sürekli hata alıyorum. Nasıl yapabilirim yardımcı olur musunuz?
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
En iyi yanıt
0
Puanları
1
Yaş
31
Konum
Eskişehir
Ad Soyad
Ali Akgün
Bu konularda çok acemiyim. Kodlar çalışıyor ve 3 kuru getiriyor.Ben ekstradan kur eklediğimde ise hata alıyorum. Nasıl yapabilirim acaba
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
En iyi yanıt
0
Puanları
1
Yaş
31
Konum
Eskişehir
Ad Soyad
Ali Akgün
ekstradan japon yeni, kanada doları, isveç kronu
 

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
128
En iyi yanıt
4
Puanları
28
Yaş
63
Konum
Emekli
ekstradan japon yeni, kanada doları, isveç kronu
Buyurun.:cool:
Kod:
Sub webten_verial()
Dim s As Long
Dim ie, t
[A2:E10] = ""
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False: ie.Navigate "http://www.tcmb.gov.tr/kurlar/today.xml"
Do While ie.Busy And Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents: Loop
Set st = ie.document.getElementById("kurlarContainer")
On Error Resume Next
For Each t In st.getElementsByTagName("*")
If Trim(t.Children(0).innertext) = "USD/TRY" Or Trim(t.Children(0).innertext) = "EUR/TRY" _
Or Trim(t.Children(0).innertext) = "GBP/TRY" Or Trim(t.Children(0).innertext) = "JPY/TRY" _
Or Trim(t.Children(0).innertext) = "CAD/TRY" Or Trim(t.Children(0).innertext) = "SEK/TRY" Then
s = Cells(Rows.Count, 1).End(3).Row + 1
Cells(s, 1) = t.Children(0).innertext
Cells(s, 2) = t.Children(3).innertext
Cells(s, 3) = t.Children(4).innertext
Cells(s, 4) = t.Children(5).innertext
Cells(s, 5) = t.Children(6).innertext
End If
Next
Set st = Nothing
ie.Quit
End Sub
 

aliakgun

Yeni Üye
Katılım
12 May 2019
Mesajlar
5
En iyi yanıt
0
Puanları
1
Yaş
31
Konum
Eskişehir
Ad Soyad
Ali Akgün
Teşekkür ederim hocam elleriniz dert görmesin.
 

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
128
En iyi yanıt
4
Puanları
28
Yaş
63
Konum
Emekli
Haluk beyin kodları, direk xml'den veri alıyor.
İE ' yi açmıyor.
Birde bunları deneyiniz.:cool:
Kod:
Sub XMLDosyasiniOku_HD()
    'Haluk
    '06/08/2018 - 13/05/2019
    '
    Dim XDoc As Object, strURL As String
    Dim myList As Object
    Dim Num As Byte
  
    Range("A2:G100") = ""

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    strURL = "http://www.tcmb.gov.tr/kurlar/today.xml"
    XDoc.Load strURL
    'Set myList = XDoc.SelectNodes("//Currency") HEPSİNİ LİSTELEMEK İÇİN
    Set myList = XDoc.SelectNodes("//Currency[CurrencyName='US DOLLAR' or CurrencyName='JAPENESE YEN' or CurrencyName='SWISS FRANK']")
    If myList.Length = 0 Then GoTo SafeExit:
    Num = myList.Length - 1
    For i = 0 To Num
        Cells(i + 2, 1) = i + 1
        Cells(i + 2, 2) = myList(i).ChildNodes(0).Text
        Cells(i + 2, 3) = myList(i).ChildNodes(1).Text
        Cells(i + 2, 4) = myList(i).ChildNodes(3).Text
        Cells(i + 2, 5) = myList(i).ChildNodes(4).Text
        Cells(i + 2, 6) = myList(i).ChildNodes(5).Text
        Cells(i + 2, 7) = myList(i).ChildNodes(6).Text
    Next
SafeExit:
    Set myList = Nothing
    Set XDoc = Nothing
MsgBox "bitti"
End Sub
 
Üst Alt