Kursna lista postoji od datuma 15. maja 2002. godine, pa nadalje.
Sto se tice RegisterUDF jasno mi je cemu sluzi, ali mi nije jasno zasto on radi u Excel 2013 a ne radi u Excel 2007.
Ubacio sam i da izbaci gresku za datume starije od 15.05.2002. godine.
Sto se tice zaokruzivanja nisam jos siguran sta tacno rade posto sam naleteo samo na jedan slucaj. To je slucaj kada je poslednja cifra 5, a znamo i matematicki da je tada dozvoljeno da se zaokruzi na cifru vise ili ostavi bez zaokruzivanja, zavisno od metode koja se koristi.
Code:
Public Function kursNBS(datum As Date, Optional kojaValuta, Optional kojiKurs) As Double
Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim oRow As Object, oCell As Object
Dim kupovni As Double
Dim prodajni As Double
Dim srednji As Double
' Provera datuma
If Not (CheckDate(datum)) Then
kursNBS = CVErr(xlErrValue) 'vraca #VALUE!
Exit Function
End If
' Default parametri
If IsMissing(kojaValuta) = True Then kojaValuta = "EUR"
If IsMissing(kojiKurs) = True Then kojiKurs = "sre"
kojiKurs = LCase(Left(Trim(kojiKurs), 3)) ' Pretvaram kojiKurs u mala slova
kojaValuta = UCase(Trim(kojaValuta)) 'pretvaram valutu (npr EUR) u velika slova.
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://www.nbs.rs/kursnaListaModul/zaDevize.faces?date=" & datum & ".&listno=&year=" & Year(datum) & "&listtype=html&lang=lat", False
.Send
oDom.body.innerHtml = .responseText
End With
With oDom.getelementsbytagname("TABLE")(1)
For Each oRow In .Rows 'prolazim kroz sve redove u tabeli 1
'u 2. koloni trazim oznaku za valutu
If oRow.Cells(2).innerText = kojaValuta Then
kupovni = Val(oRow.Cells(4).innerText) 'u 4. koloni trazim kupovni
prodajni = Val(oRow.Cells(5).innerText) 'u 5. koloni trazim prodajni
srednji = (kupovni + prodajni) / 2
If kojiKurs = "sre" Then kursNBS = srednji: Exit Function
If kojiKurs = "kup" Then kursNBS = kupovni: Exit Function
If kojiKurs = "pro" Then kursNBS = prodajni: Exit Function
End If
Next oRow
End With
End Function
Private Function CheckDate(dat As Date) As Boolean
' Pomocna funkcija za proveru ispravnosti zadatog datuma
If dat <= 0 Then ' Provera da li je unesen datum
CheckDate = False
Exit Function
End If 'Provera da li je datum u buducnosti. Kursna lista se formira tek u 8h svakog dana
If dat + 8 / 24 > Now() Then
CheckDate = False
Exit Function
End If 'na sajtu NBS ne postoje datumi pre 15.05.2002. godine
If dat < "15.05.2002" Then
CheckDate = False
Exit Function
End If
CheckDate = True
End Function
Sub RegisterUDF()
Dim FuncName As String
Dim FuncDesc As String
Dim Category As String
Dim ArgDesc(1 To 3) As String
FuncName = "KursNBS"
FuncDesc = "Kurs odredjene valute na dan preko api poziva NBS.com"
Category = 1 'Financial Category
ArgDesc(1) = "Dan za koji se traži kursna lista"
ArgDesc(2) = "eur, usd, gbp, chf - videti na sajtu kursna lista. Defult je eur"
ArgDesc(3) = "Tip Kursakupovni, srednji ili prodajni. Default je srednji"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub
Sub UnregisterUDF()
Application.MacroOptions Macro:="KursNBS", Description:=Empty, Category:=Empty
End Sub
Primetio sam jedan "problem" koji se manifestuje samo kod tabela sa velikim brojem upita za neki od kurseva.
Naime, kada postoji puno upita za kurs, u zavisnosti od brzine Interneta, potrebno je odredjeno vreme da se kursevi skinu, sto nije problematicno. Eventualni problem je sto ukoliko se npr u tabeli koristi filter, kada filtliramo neku vrednost, Excel ponovo osvezava sve unose cini mi se da ponovo skida sve podatke sa sajta. Moze se to resiti tako sto kad se prvi put ocitaju kursevi, sve prelepimo sa paste values, jer jednom ocitan kurs se nece menjati, ali me cisto informaticki zanima moze li se spreciti da ih ponovo osvezava prilikom manipulacijom tabele?
[Ovu poruku je menjao Blue82 dana 16.07.2017. u 16:33 GMT+1]