tcmb.gov.tr'den dövizleri çekmek

mehmethanifi

tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen mehmethanifi »

Merhabalar,

tcmb.gov.tr'den döviz kurlarını çekmek istiyoruz. Bunun ile ilgili aşağıdaki linkte güzel bir örnek bulduk.
http://wiki.libreoffice.org.tr/Nas%C4%B ... 4%B1_Almak

Yanlız macro kodlarını tarif edilen yere yapıştırıp çalıştırdığım zaman hata aldım.
"Basic, Standard.Module1.DOVIZKURUNUAL betiği çalıştırılırken, betik dili çatı hatası oluştu.

Mesaj: wrong number of parameters!"

ilgili kodu yapıştırdığım metin alanı şu şekilde.

REM ***** BASIC *****


Function DOVIZKURUNUAL( Tarih As Date, ByVal HedefBirim As String, Kur As Byte, AnaPara As Double ) As Double

On Error Goto Hata

Dim BankaWebAdresi
Dim Dosya
Dim Satir As String
Dim Sonuc As Double
Dim BaslangicTarihi As Date
Dim BitisTarihi As Date

HedefBirim = UCase(HedefBirim)

BaslangicTarihi = "16/04/1996"
BitisTarihi = Date

If (Tarih < BaslangicTarihi) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"16/04/1996 Tarihinden önceki T.C. Merkez Bankası döviz kurları" & Chr(10) & +_
"web sitesine girilmemiştir. Lütfen uygun bir tarih giriniz."
Goto Hata
End If

If (Tarih > BitisTarihi) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Girilen Tarih için günlük kur kaydı bulunamadı. Lütfen uygun bir tarih giriniz."
Goto Hata
End If

If ((HedefBirim <> "USD") And (HedefBirim <> "AUD") And (HedefBirim <> "DKK") And +_
(HedefBirim <> "EUR") And (HedefBirim <> "GBP") And (HedefBirim <> "CHF") And +_
(HedefBirim <> "SEK") And (HedefBirim <> "CAD") And (HedefBirim <> "KWD") And +_
(HedefBirim <> "NOK") And (HedefBirim <> "SAR") And (HedefBirim <> "JPY") And +_
(HedefBirim <> "BGL") And (HedefBirim <> "SYP") And (HedefBirim <> "JOD") And +_
(HedefBirim <> "ILS") And (HedefBirim <> "RON") And (HedefBirim <> "IRR")) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Hedef Para Birimi Tanınmıyor ve/veya" & Chr(10) & +_
"T.C. Merkez Bankasında işlem görmüyor." & Chr(10) & +_
"Girilebilecek Para Birimleri aşağıda listelenmiştir." & Chr(10) & +_
"USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD," & Chr(10) & +_
"NOK, SAR, JPY, BGL, SYP, JOD, ILS, RON, IRR"
Goto Hata
End If

If ((Kur < 1) Or (Kur > 4)) Then
Beep
MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; ParaMiktarı )" & Chr(10) & Chr(13) & +_
"Dönüşüm için gerekli olan KUR TÜRÜ bilgisi tanımsız." & Chr(10) & +_
"1:Döviz Alış, 2:Döviz Satış, 3:Efektif Alış, 4:Efektif Satış" & Chr(10) & +_
"Lütfen KUR TÜRÜ parametresini doğru giriniz."
Goto Hata
End If

BankaWebAdresi = "http://www.tcmb.gov.tr/kurlar/" & Year(Tarih) & Format(Month(Tarih),"0#") & "/" & Format(Day(Tarih),"0#") & Format(Month(Tarih),"0#") & Year(Tarih) & ".html"

Dosya = FreeFile()
Open BankaWebAdresi For Input As Dosya

While Not Eof(Dosya)
Line Input #Dosya, Satir
If Left(Satir,3) = HedefBirim Then
If (Tarih < CDate("28/01/2002")) Then
Sonuc = AnaPara / Val(Mid(Satir, 17 + Kur * 10, 10))
ElseIf (Tarih >= CDate("28/01/2002")) Then
Sonuc = AnaPara / Val(Mid(Satir, 17 + Kur * 16, 16))
EndIf
Close #Dosya
DOVIZKURUNUAL() = Sonuc
Exit Function
EndIf
Wend

Close #Dosya

Hata:

DOVIZKURUNUAL() = 0.0

End Function

Teşekkürler.
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen Hamurcu »

Merhaba,

İlgili kodu ben yazmıştım zamanında ama sonradan TCMB'nin web sayfası yenilendi ve tüm ayarlar değişti.

Kodu tekrar ele almam lazım bu hali ile doğru çalışmaz.

Basic bilen arkadaşlar varsa kodu geliştirebilirler aksi helde ben ilk fırsat bulduğumda kodu yenileyeceğim.
mehmethanifi

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen mehmethanifi »

Çok teşekkür ederim.
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen Hamurcu »

Merhaba,

Bir fırsat bulup T.C. Merkez Bankasının yeni web sayfasına göre ilgili kodu güncelledim.

Öncelikle sizlerden ricam deneyip varsa eksik/hata bildirmeniz.

Daha sonra son halini verip wiki'de yayınlayacağım.

Kullanım şekli şöyle;

Kod: Tümünü seç

=DOVIZKURUAL(Tarih; DovizCinsi; KurTürü; TLMiktarı)
Tarih : Verilen tarihe ait Döviz Kur'u
DövizCinsi : T.C. Merkez Bankasında işlem gören döviz cinsleridir. Örneğin USD, EUR v.b.
KurTürü : Döviz Alış için 1, Döviz Satış için 2, Efektif Alış için 3, Efektif Satış için 4 girilmelidir.
TLMiktarı : Ana Para olarak girilecek değerdir ve yukarıdaki fonksiyon otomatik olarak ilgili para birimine çevirir.

Güncel kod ise şöyle;

Kod: Tümünü seç

Function DovizKuruAl(Tarih As Date, ParaBirimi As String, KurTuru As Byte, AnaPara As Double) As Double

On Error Goto Hata

Dim oleServisi, XMLOku As Object
Dim XMLDal As String
Dim DovizAlis,DovizSatis, EfektifSatis, EfektifAlis As Double
Dim MerkezBankasi, HedefKurAdi As String
Dim Sonuc As Double
Dim BaslangicTarihi As Date
Dim BitisTarihi As Date
Dim HedefKurNo As Byte
Dim Sayfa As Object

BaslangicTarihi = "16/04/1996"

BitisTarihi = Date

ParaBirimi = UCase(ParaBirimi)

Sonuc=0.0

If (Tarih < BaslangicTarihi) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
		   "16/04/1996 Tarihinden önceki T.C. Merkez Bankası döviz kurları" & Chr(10) & +_
		   "web sitesine girilmemiştir. Lütfen uygun bir tarih giriniz."
	Goto Hata
End If

If (Tarih > BitisTarihi) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
	       "Girilen Tarih için günlük kur kaydı bulunamadı. Lütfen uygun bir tarih giriniz."
	Goto Hata
End If

If ((ParaBirimi <> "USD") And (ParaBirimi <> "AUD") And (ParaBirimi <> "DKK") And +_
	(ParaBirimi <> "EUR") And (ParaBirimi <> "GBP") And (ParaBirimi <> "CHF") And +_
	(ParaBirimi <> "SEK") And (ParaBirimi <> "CAD") And (ParaBirimi <> "KWD") And +_
	(ParaBirimi <> "NOK") And (ParaBirimi <> "SAR") And (ParaBirimi <> "JPY") And +_
	(ParaBirimi <> "BGN") And (ParaBirimi <> "PKR") And (ParaBirimi <> "CNY") And +_
	(ParaBirimi <> "RUB") And (ParaBirimi <> "RON") And (ParaBirimi <> "IRR")) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
		   "Hedef Para Birimi Tanınmıyor ve/veya" & Chr(10) & +_
		   "T.C. Merkez Bankasında işlem görmüyor." & Chr(10) & +_
		   "Girilebilecek Para Birimleri aşağıda listelenmiştir." & Chr(10) & +_
		   "USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD," & Chr(10) & +_
		   "NOK, SAR, JPY, BGN, RON, RUB, IRR, CNY, PKR"
	Goto Hata
End If

If ((KurTuru < 1) Or (KurTuru > 4)) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru ; AnaParaMiktarı )" & Chr(10) & Chr(13) & +_
		   "Dönüşüm için gerekli olan KUR TÜRÜ bilgisi tanımsız." & Chr(10) & +_
		   "1:Döviz Alış, 2:Döviz Satış, 3:Efektif Alış, 4:Efektif Satış" & Chr(10) & +_
		   "Lütfen KUR TÜRÜ parametresini doğru giriniz."
	Goto Hata
End If 

Select Case ParaBirimi
	Case "USD"
		HedefKurNo=0
		HedefKurAdi="US DOLLAR"
	Case "AUD"
		HedefKurNo=1
		HedefKurAdi="AUSTRALIAN DOLLAR"
	Case "DKK"
		HedefKurNo=2
		HedefKurAdi="DANISH KRONE"
	Case "EUR"
		HedefKurNo=3
		HedefKurAdi="EURO"
	Case "GBP"
		HedefKurNo=4
		HedefKurAdi="POUND STERLING"
	Case "CHF"
		HedefKurNo=5
		HedefKurAdi="SWISS FRANK"
	Case "SEK"
		HedefKurNo=6
		HedefKurAdi="SWEDISH KRONA"
	Case "CAD"
		HedefKurNo=7
		HedefKurAdi="CANADIAN DOLLAR"
	Case "KWD"
		HedefKurNo=8
		HedefKurAdi="KUWAITI DINAR"
	Case "NOK"
		HedefKurNo=9
		HedefKurAdi="NORWEGIAN KRONE"
	Case "SAR"
		HedefKurNo=10
		HedefKurAdi="SAUDI RIYAL"
	Case "JPY"
		HedefKurNo=11
		HedefKurAdi="JAPENESE YEN"
	Case "BGN"
		HedefKurNo=12
		HedefKurAdi="BULGARIAN LEV"
	Case "RON"
		HedefKurNo=13
		HedefKurAdi="NEW LEU"
	Case "RUB"
		HedefKurNo=14
		HedefKurAdi="RUSSIAN ROUBLE"
	Case "IRR"
		HedefKurNo=15
		HedefKurAdi="IRANIAN RIAL"
	Case "CNY"
		HedefKurNo=16
		HedefKurAdi="CHINESE RENMINBI"
	Case "PKR"
		HedefKurNo=17
		HedefKurAdi="PAKISTANI RUPEE"
End Select

oleServisi = createUnoService( "com.sun.star.sheet.FunctionAccess" )

MerkezBankasi = "http://www.tcmb.gov.tr/kurlar/" & Year(Tarih) & Format(Month(Tarih),"0#") & "/" & +_
				Format(Day(Tarih),"0#") & Format(Month(Tarih),"0#") & Year(Tarih) & ".xml"

With oleServisi

	XML_String = .callFunction("WEBSERVICE",array(MerkezBankasi))

	For Birimler=0 To 17
	
		XMLDal= .callFunction("FILTERXML", array(XML_String, "string(/Tarih_Date/Currency["+Birimler+"]/CurrencyName[1])"))
    
		If XMLDal=HedefKurAdi Then
			DovizAlis    = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/ForexBuying[1])"))
			DovizSatis   = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/ForexSelling[1])"))
			EfektifAlis  = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/BanknoteBuying[1])"))
			EfektifSatis = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency["+Birimler+"]/BanknoteSelling[1])"))
		End If

	Next Birimler
	
	Select Case KurTuru
		Case 1
			Sonuc=AnaPara/DovizAlis
   		Case 2
   			Sonuc=AnaPara/DovizSatis
   		Case 3
   			Sonuc=AnaPara/EfektifAlis
   		Case 4
   			Sonuc=AnaPara/EfektifSatis
   	End Select
    		
	DovizKuruAl() = Sonuc

	Exit Function

End With
	
Hata:

	DovizKuruAl() = 0.0
	
End Function
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen Hamurcu »

Merhaba,

Kodları biraz daha düzenledim.

1. Merkez bankasındaki xml dosyasının adı bugün için farklı, daha eski tarihler için farklı olma durumu eklendi.
2. AnaPara'yı kaldırdım sonuçta Calc içerisinde istediğiniz gibi bölme yapabilirsiniz.
3. XML filtrelerini doğrudan ismini yazarak çalıştırdım, gereksiz FOR NEXT döngüsünü kaldırdım.
4. HedefKurAdı'na ihtiyaç kalmadığından kaldırdım.

Son hali;

Kod: Tümünü seç

Function DovizKuruAl(Tarih As Date, ParaBirimi As String, KurTuru As Byte) As Currency

On Error Goto Hata

Dim oleServisi As Object
Dim DovizAlis,DovizSatis, EfektifSatis, EfektifAlis As Currency
Dim MerkezBankasi, HedefKurAdi As String
Dim Sonuc As Currency
Dim BaslangicTarihi As Date
Dim BitisTarihi As Date
Dim HedefKurNo As Byte
Dim Sayfa As Object

BaslangicTarihi = "16/04/1996"

BitisTarihi = Date

ParaBirimi = UCase(ParaBirimi)

Sonuc=0.0

If (Tarih < BaslangicTarihi) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru )" & Chr(10) & Chr(13) & +_
		   "16/04/1996 Tarihinden önceki T.C. Merkez Bankası döviz kurları" & Chr(10) & +_
		   "web sitesine girilmemiştir. Lütfen uygun bir tarih giriniz."
	Goto Hata
End If

If (Tarih > BitisTarihi) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru )" & Chr(10) & Chr(13) & +_
	       "Girilen Tarih için günlük kur kaydı bulunamadı. Lütfen uygun bir tarih giriniz."
	Goto Hata
End If

If ((ParaBirimi <> "USD") And (ParaBirimi <> "AUD") And (ParaBirimi <> "DKK") And +_
	(ParaBirimi <> "EUR") And (ParaBirimi <> "GBP") And (ParaBirimi <> "CHF") And +_
	(ParaBirimi <> "SEK") And (ParaBirimi <> "CAD") And (ParaBirimi <> "KWD") And +_
	(ParaBirimi <> "NOK") And (ParaBirimi <> "SAR") And (ParaBirimi <> "JPY") And +_
	(ParaBirimi <> "BGN") And (ParaBirimi <> "PKR") And (ParaBirimi <> "CNY") And +_
	(ParaBirimi <> "RUB") And (ParaBirimi <> "RON") And (ParaBirimi <> "IRR")) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru )" & Chr(10) & Chr(13) & +_
		   "Hedef Para Birimi Tanınmıyor ve/veya" & Chr(10) & +_
		   "T.C. Merkez Bankasında işlem görmüyor." & Chr(10) & +_
		   "Girilebilecek Para Birimleri aşağıda listelenmiştir." & Chr(10) & +_
		   "USD, AUD, DKK, EUR, GBP, CHF, SEK, CAD, KWD," & Chr(10) & +_
		   "NOK, SAR, JPY, BGN, RON, RUB, IRR, CNY, PKR"
	Goto Hata
End If

If ((KurTuru < 1) Or (KurTuru > 4)) Then
	Beep
	MsgBox "=DOVIZKURUNUAL( Tarih ; HedefParaBirimi ; KurTuru )" & Chr(10) & Chr(13) & +_
		   "Dönüşüm için gerekli olan KUR TÜRÜ bilgisi tanımsız." & Chr(10) & +_
		   "1:Döviz Alış, 2:Döviz Satış, 3:Efektif Alış, 4:Efektif Satış" & Chr(10) & +_
		   "Lütfen KUR TÜRÜ parametresini doğru giriniz."
	Goto Hata
End If 

oleServisi = createUnoService( "com.sun.star.sheet.FunctionAccess" )

If (Tarih=Date) Then
	MerkezBankasi = "http://www.tcmb.gov.tr/kurlar/today.xml"
	Else
	MerkezBankasi = "http://www.tcmb.gov.tr/kurlar/" & Year(Tarih) & Format(Month(Tarih),"0#") & "/" & +_
					Format(Day(Tarih),"0#") & Format(Month(Tarih),"0#") & Year(Tarih) & ".xml"
End If

With oleServisi

	XML_String = .callFunction("WEBSERVICE",array(MerkezBankasi))

	DovizAlis    = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency[@CurrencyCode='"+ParaBirimi+"']/ForexBuying)"))
	DovizSatis   = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency[@CurrencyCode='"+ParaBirimi+"']/ForexSelling)"))
	EfektifAlis  = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency[@CurrencyCode='"+ParaBirimi+"']/BanknoteBuying)"))
	EfektifSatis = .callFunction("FILTERXML", array(XML_String, "number(/Tarih_Date/Currency[@CurrencyCode='"+ParaBirimi+"']/BanknoteSelling)"))
	
	Select Case KurTuru
		Case 1
			Sonuc=DovizAlis
   		Case 2
   			Sonuc=DovizSatis
   		Case 3
   			Sonuc=EfektifAlis
   		Case 4
   			Sonuc=EfektifSatis
   	End Select
    		
	DovizKuruAl() = Sonuc

	Exit Function

End With
	
Hata:

	DovizKuruAl() = 0.0
	
End Function
En son Hamurcu tarafından 26 May 2017, 17:21 tarihinde düzenlendi, toplamda 1 kere düzenlendi.
mehmethanifi

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen mehmethanifi »

Hocam aşağıda görülen hatayı aldım.
Resim
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen Hamurcu »

Merhaba,

Yazmayı unutmuşum kullanım şekli şöyle olacak;

Kod: Tümünü seç

=DOVIZKURUAL ( Tarih ; ParaBirimi ; KurTürü )
KurTürü olarak 1-4 arası bir rakam gireceksiniz.
1 : Döviz Alış
2 : Döviz Satış
3 : Efektif Alış
4 : Efektif Satış

Daha önce Ana Para miktarını da parametre olarak alıp doğrudan kur'a bölüyorduk, artık sadece günlük kur'u alıyoruz.
mehmethanifi

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen mehmethanifi »

Hocam yanlış bir işlem mi yapıyorum?
Resim
Kullanıcı avatarı
Hamurcu
Mesajlar: 265
Kayıt: 06 Ağu 2012, 00:14
İşletim Sisteminiz: Windows 10/11 - Pardus Linux
LibreOffice Sürümü: 7.x

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen Hamurcu »

Merhaba,

Örneğin aşağıdaki gibi bir tablo yapalım.
ornektablo1
ornektablo1
soffice.bin_2017-05-26_17-08-02.png (7.26 KiB) 6148 kere görüntülendi
Tablodaki formüller aşağıdaki gibi olmalıdır.
formuller
formuller
soffice.bin_2017-05-26_17-08-35.png (14.08 KiB) 6148 kere görüntülendi
Eğer makroyu da doğru şekilde eklediysen çalışacaktır.

Örnek dosyayı ekliyorum.
DovizKurlari.ods
kur
(14.69 KiB) 350 kere indirildi
mehmethanifi

Re: tcmb.gov.tr'den dövizleri çekmek

Mesaj gönderen mehmethanifi »

Hocam sanıyorum yanlış yapıyorum galiba.
Sizin dosyanızı açtığım zaman komutların çalışmadığını görüyorum.
Resim
Macro'yu çalıştır dediğim zaman ise aşağıdaki hata ekrana yansıyor. Burada yanlış bir işlem yaptığımı düşünüyorum.
Resim
Cevapla