|
Курс доллара для любой заданной даты |
  
|
|
Курс доллара для любой заданной даты |
|
Если Вам часто приходится узнавать курс доллара для определенной заданной даты в прошлом (даты заказа или поставки, например), то этот макрос сэкономит вам много времени.
Откройте редактор Visual Basic (Сервис - Макрос - Редактор Visual Basic), вставьте новый модуль (Insert - Module) и скопируйте туда текст этого макроса:
Sub GetDollar()
Dim sURI As String
Dim oHttp As Object
Dim htmlcode, outstr As String
Dim inpdate As Date
Dim d, m, y As Integer
inpdate = CDate(InputBox("Введите дату в формате _
ДД.ММ.ГГГГ", "Курс доллара", Date))
d = Left(inpdate, 2)
m = Mid(inpdate, 4, 2)
y = Right(inpdate, 4)
sURI = "http://cbr.ru/currency_base/daily.asp?C_month= _
" & m & "&C_year=" & y & "&date_req=" & d & "% _
2F" & m & "%2F" & y & "&d1=" & d
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp Is Nothing Then
Exit Sub
End If
oHttp.Open "GET", sURI, False
oHttp.Send
htmlcode = oHttp.responseText
outstr = Mid(htmlcode, InStr(1, htmlcode, "USD") + 85, 7)
Set oHttp = Nothing
ActiveCell.Value = CDbl(outstr)
End Sub
Теперь, если закрыть редактор Visual Basic и вернуться в Excel, то через меню Сервис - Макрос - Макросы можно запустить наш макрос GetDollar, ввести в появившееся окно дату и получить курс доллара для заданной даты в текущей ячейке. Для удобства запуска можно сделать кнопку макроса на панели инструментов или на листе или назначить макросу сочетание клавиш.
Фактически, макрос загружает данные из архива сайта Центробанка РФ, поэтому для вставки курса в текущую ячейку необходимо иметь доступ в интернет (в данный момент). Данные вставляются как константы (без связи и обновления).
|
|
 |
