Hocam kaldırdım. Son hali aşağıda ki gibidir.
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
Yukarıdaki komutu çalıştırdığım zaman karşılaştığım hata..