Function Курс_Доллара(Optional ByVal Дата) As Currency   ' запрос курса Доллара США с сайта ЦБ РФ
     '---------------------------------------------------------------------------------------
     ' Procedure : Курс_Доллара
     ' Author    : Основа - Pavel55, коррекция - Alex_ST: 2010-01-28
     ' URL       : http://www.planetaexcel.ru/forum.php?thread_id=6870&page_forum=2&allnum_forum=34
     ' Date      : 28.01.2010
     ' Purpose   : Запрос курса Доллара, установленного ЦБР на заданную дату
     ' Notes     : По умолчанию - текущая дата
     '---------------------------------------------------------------------------------------
     Dim Запрос$, Ответ$, Курс$
     Dim oHttp As Object
     Dim ДЕНЬ$, Месяц$, ГОД$
     Application.Volatile
     If IsMissing(Дата) Then Дата = Date
     If Not IsDate(Дата) Then Дата = CDate(Дата)
     ДЕНЬ = Format(Дата, "dd"): Месяц = Format(Дата, "mm"): ГОД = Format(Дата, "yyyy")
     Запрос = "http://cbr.ru/currency_base/daily.aspx?C_month=" & Месяц & "&C_year=" _
              & ГОД & "&date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
     On Error Resume Next
     Set oHttp = CreateObject("MSXML2.XMLHTTP")
     If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
     On Error GoTo 0
     If oHttp Is Nothing Then Exit Function
     oHttp.Open "GET", Запрос, False
     oHttp.Send
     Ответ = UCase(oHttp.responseText)
     Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "USD"), Ответ, "</TD></TR>") - 7, 7))
     Set oHttp = Nothing
     Курс_Доллара = Курс
End Function

Function Курс_Евро(Optional ByVal Дата) As Currency   ' запрос курса Евро с сайта ЦБ РФ
     '---------------------------------------------------------------------------------------
     ' Procedure : Курс_Евро
     ' Author    : Основа - Pavel55, коррекция - Alex_ST: 2010-01-28
     ' URL       : http://www.planetaexcel.ru/forum.php?thread_id=6870&page_forum=2&allnum_forum=34
     ' Date      : 28.01.2010
     ' Purpose   : Запрос курса Евро, установленного ЦБР на заданную дату
     ' Notes     : По умолчанию - текущая дата
     '---------------------------------------------------------------------------------------
     Dim Запрос$, Ответ$, Курс$
     Dim oHttp As Object
     Dim ДЕНЬ$, Месяц$, ГОД$
     Application.Volatile
     If IsMissing(Дата) Then Дата = Date
     If Not IsDate(Дата) Then Дата = CDate(Дата)
     ДЕНЬ = Format(Дата, "dd"): Месяц = Format(Дата, "mm"): ГОД = Format(Дата, "yyyy")
     Запрос = "http://cbr.ru/currency_base/daily.aspx?C_month=" & Месяц & "&C_year=" _
              & ГОД & "&date_req=" & ДЕНЬ & "%2F" & Месяц & "%2F" & ГОД
     On Error Resume Next
     Set oHttp = CreateObject("MSXML2.XMLHTTP")
     If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
     On Error GoTo 0
     If oHttp Is Nothing Then Exit Function
     oHttp.Open "GET", Запрос, False
     oHttp.Send
     Ответ = UCase(oHttp.responseText)
     Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TD></TR>") - 7, 7))
     Set oHttp = Nothing
     Курс_Евро = Курс
End Function