Predlog - korisna funkcija za kursnu listu NBS

Code:
=KursNBS(A1) 
=KursNBS(A1, "USD", "pro") 

Code:
$api_id = 'f53ec1381124cf3ac11a0ac413c7ee76'; // Vaš API ID
$url = 'https://api.kursna-lista.info/'.$api_id.'/konvertor/eur/usd/20';

Code:


Sub kursNBS()
    Dim oDom As Object: Set oDom = CreateObject("htmlFile")
    Dim oRow As Object, oCell As Object
    
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "https://www.nbs.rs/kursnaListaModul/srednjiKurs.faces?lang=lat", False
        .Send
        oDom.body.innerHtml = .responseText
    End With
    
    With oDom.getelementsbytagname("TABLE")(1)

        ReDim data(.Rows.Length, .Rows(1).Cells.Length)
        
        For Each oRow In .Rows 'prolazim kroz sve redove u tabeli 1
                    'u 2. redu trazim oznaku za valutu             'ocitavam kurs iz 4. reda
            If oRow.Cells(2).innerText = "EUR" Then MsgBox (oRow.Cells(4).innerText)
        Next oRow
  
End Sub

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
    
    If datum = "00:00:00" Then kursNBS = "": Exit Function 'ako nije unet datum, on ima vrednost "00:00:00" i vracam gresku #VALUE!
    If IsMissing(kojaValuta) = True Then kojaValuta = "EUR"
    If IsMissing(kojiKurs) = True Then kojiKurs = "sre"
   
   ' pretvaram kojiKurs u mala slova
   kojiKurs = LCase(Left(Trim(kojiKurs), 3))
   kojaValuta = Trim(kojaValuta)
    
    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


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

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
    ' ako nije unet datum, on ima vrednost "00:00:00" i vracam gresku #VALUE!
    If Not (CheckDate(datum)) Then
        kursNBS1 = CVErr(xlErrValue)
        Exit Function
    End If
    ' Default parametri
    If IsMissing(kojaValuta) = True Then kojaValuta = "EUR"
    If IsMissing(kojiKurs) = True Then kojiKurs = "sre"
   
   ' Pretvaram kojiKurs u mala slova
    kojiKurs = LCase(Left(Trim(kojiKurs), 3))
    kojaValuta = Trim(kojaValuta)
     
    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 zadataog datuma
'
    If dat <= 0 Then ' Provera da li je unesen datum
        CheckDate = False
        Exit Function
    End If           'Provera da li je datum u budućnosti
    If dat + 8 / 24 > Now() Then
        CheckDate = False
        Exit Function
    End If
    CheckDate = True
    
End Function

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