Automatizujeme reporty: automatické aktualizácie kurzu €

Určite ste sa už niekedy stretli s reportom, ktorý v sebe obsahoval Kč-y a €-á. Takýto report v sebe pravdepodobne obsahuje sheet s tabuľkou, obsahujúcou kurzy podľa dátumu, kedy bol report robený a dáte mi za pravdu ,že buď trávite niekoľko minút copy-paste-ním aktuálnych sadzieb z centrálnej banky alebo máte komplikovanú procedúru, ktorá stiahne celý .CSV súbor a vytiahne z neho hodnotu, ktorú momentálne potrebujete.

Čo tak zvoliť elegantnejší spôsob?

Ja som sa v rámci svojich reportov rozhodol obísť tieto procedúry a vytvoril som si funkciu s názvom =eukurz(“dátum”). Jej výhoda spočíva v jednoduchosti, stačí ak ju odkážete na bunku s dátumom a ona Vám vráti požadovaný kurz.

VBA riešenie vyzerá nasledovne:

Function EuKurz(datum As Date)
Dim Mena As String
Dim CNBfix
Dim SDatum As String
Dim CNBobjekt
Dim URL
Mena = "EUR"
CNBfix = TimeSerial(14, 30, 0)
Set CNBobjekt = CreateObject("MSXML2.XMLHTTP")
  
'Ošetríme možnosť, že dátum je z budúcna
If datum > Format(Now, "Short Date") Or datum = "0:00:00" Then
    EuKurz = " "
    Exit Function
End If
  
'ČNB aktualizuje kurzy po 14.30 - t.z. pred 14:30 vezmeme kurz z predch. dňa
If datum = Format(Now, "Short Date") Then
    If Time < CNBfix Then
        datum = datum - 1
    End If
End If
   
'Ak je dátum rovný Sobote alebo Nedeli, posunieme sa a použijeme kurz z najbližšieho piatku
If (Weekday(datum, vbMonday) > 5) Then
    datum = datum - Weekday(datum, vbMonday) + 5
End If
'SDatum pre odkazSDatum = Format(datum, "dd.mm.yyyy")
 
'adresa odkazu (ČNB)URL = "http://www.cnb.cz/miranda2/m2/cs/financni_trhy/devizovy_trh/kurzy_devizoveho_trhu/vybrane.txt?mena=" & Mena & "&od=" & SDatum & "&do=" & SDatum
CNBobjekt.Open "GET", URL, False
CNBobjekt.send

If (InStr(1, CNBobjekt.responseText, SDatum)) = 0 Then
    EuKurz = "-"
Else
    EuKurz = Mid(CNBobjekt.responseText, InStr(1, CNBobjekt.responseText, SDatum) + Len(SDatum) + 1, Len(CNBobjekt.responseText))
End If
'On error resume next v prípade, že používate iný než anglický Excel (aby výsledok nebol #HODNOTA!)On Error Resume NextEuKurz = CDbl(Replace(EuKurz, ",", "."))
EuKurz = CDbl(EuKurz)
Set CNBobjekt = Nothing

End Function

Nakoľko sa daný kód môže zdať trošku komplikovaný, je to spôsobené tzv. ošetrujúcimi podmienkami. Každopádne si hotovú funkciu môžete stiahnuť kliknutím na obrázok Download a nezabudnite na Facebook skupinu