Данный код (пользовательская функция) позволяет получить данные о курсе валюты с сайта Центробанка. Данную функцию можно использовать и в виде формулы на листе Excel (см. пример во вложении) Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Single ' функция возвращает курс валюты CurrencyName на дату RateDate ' в случае ошибки (неверная дата или название валюты) возвращается 0 On Error Resume Next CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy") If xmldoc.Load(url_request) <> True Then Exit Function ' Запрос к серверу ЦБР ' Обработка полученного ответа Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/Valute") For i = 0 To nodeList.Length - 1 ' поиск нужной валюты Set xmlNode = nodeList.Item(i).CloneNode(True) If xmlNode.childNodes(1).Text = CurrencyName Then CurrencyRate = CDbl(xmlNode.childNodes(4).Text) divisor = Val(xmlNode.childNodes(2).Text) GetRate = CurrencyRate / divisor Exit Function End If Next End Function Sub ПримерИспользованияФункции_GetRate() MsgBox "Сегодня курс доллара к рублю составил " & GetRate("USD", Now), vbInformation MsgBox "А вчера курс евро к рублю был равен " & GetRate("EUR", Now - 1), vbInformation End Sub Поддерживается получение курсов рубля по отношению к следующим валютам:
Если вы желаете вывести информацию по всем валютам - используйте макрос ВывестиСегодняшниеКурсыВсехВалют: Sub ВывестиСегодняшниеКурсыВсехВалют() On Error Resume Next Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd\/mm\/yyyy") If xmldoc.Load(url_request) <> True Then Exit Sub Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/Valute") For i = 0 To nodeList.Length - 1 Set xmlNode = nodeList.Item(i).CloneNode(True) Debug.Print "Курс " & xmlNode.childNodes(1).Text & " (установлен " & strDate & "): " & _ xmlNode.childNodes(4).Text & " рублей за " & xmlNode.childNodes(2).Text & _ " " & xmlNode.childNodes(3).Text Next End Sub Результат работы макроса ВывестиСегодняшниеКурсыВсехВалют:
|
|||||||
Комментарии
А чем не устраивает http://pfsoft.com.ua/service/currency/ ?
Я тоже искал XML на сайте нацбанка Украины и не нашёл. Уже 4-5 месяцев пользуюсь ссылкой указанной выше.
Да и ниже есть мой коммент где писал как изменить существующий макрос для гривни...
коллеги ,а есть скрипт для выкачки USD/EUR к UAH? с нац банка украины ? http://www.bank.gov.ua/control/uk/curmetal/currency/search/form/day
Добрый день, макрос просто супер, огромное спасибо! А возможно его дописать, что можно было выгружать курс к USD? Пример: USD/EUR
мне нужен макрос с сегодняшними торгами по доллару и евро и чтобы ячейку с данными по курсам можно вставить в формулу рассчета сумм.заказ оформлять надо?
Да, возможно.
Обновлять данные, конечно, можно и каждый час, но гораздо проще делать это непосредственно в тот момент, когда необходимо обновить данные на листе.
а возможно создать макрос с торгами валют на ммвб,который бы обновлялся каждый час.для вставки в др функцию,чтобы пересчитать нужные суммы к уплате по курсу торгов на данное время
Спс, а то я сделал тоже самое, но через такую кривую попу...
Возникла необходимость получать данные не по рублям, а по украинским гривням. Немного покопавшись нашёл линк на аналогичный XML:
url_request = "http://pfsoft.com.ua/service/currency/?date=" + Format(Now, "ddmmyyyy")
это если менять в теле процедуры. Кроме того у них разделитель не запятая, а точка, так что в теле цикла нужно добавить строчку типа:
curr = Replace(xmlNode.ChildNodes(4).Text, ".", ",")
Может кому и пригодиться :)
Огромное спасибо!!!
Уважаемый, EducatedFool!
Ты - Бог, комментарии излишни...
Отправить комментарий