суть моей темы - макрос(модуль) по импорту курса валют в эксель с оф сайта Нац Банка Украины.
Идея такова: в одну ячейку пишется Валюта (USD/EUR и тд), в соседнюю дата (дд.мм.гггг, хотя дальше может потребуется писать и ггггммдд в целях ссылки на страницу хмл). Рядом вставляется формула =GetRate(A2,В2), где А2 В2 соответсвенно ссылки на ячейки, ранее описанные. Я финансист и слаб в написании макросов, но пытался сам разобраться, что получилось:
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Integer) As Single
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://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
If xmldoc.Load(url_request) <> True Then Exit Function
Set nodeList = xmldoc.selectNodes("exchange"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/currency") 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) GetRate = CurrencyRate Exit Function End If Next End Function
[/vba]
Прощу помощи с адаптированием ее к данной ссылке или же у кого есть уже рабочий макрос(модуль) для выполнения подобной операции - буду очень признателен
Доброго времени суток,
суть моей темы - макрос(модуль) по импорту курса валют в эксель с оф сайта Нац Банка Украины.
Идея такова: в одну ячейку пишется Валюта (USD/EUR и тд), в соседнюю дата (дд.мм.гггг, хотя дальше может потребуется писать и ггггммдд в целях ссылки на страницу хмл). Рядом вставляется формула =GetRate(A2,В2), где А2 В2 соответсвенно ссылки на ячейки, ранее описанные. Я финансист и слаб в написании макросов, но пытался сам разобраться, что получилось:
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Integer) As Single
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://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD")
If xmldoc.Load(url_request) <> True Then Exit Function
Set nodeList = xmldoc.selectNodes("exchange"): Set xmlNode = nodeList.Item(0).CloneNode(True) Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value Set nodeList = xmldoc.selectNodes("*/currency") 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) GetRate = CurrencyRate Exit Function End If Next End Function
[/vba]
Прощу помощи с адаптированием ее к данной ссылке или же у кого есть уже рабочий макрос(модуль) для выполнения подобной операции - буду очень признателенkkravets
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) 'As Double CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD") Debug.Print url_request
If xmldoc.Load(url_request) <> True Then Exit Function Set nodeList = xmldoc.SelectNodes("*/currency") For i = 0 To nodeList.Length - 1 If nodeList.Item(i).ChildNodes.Length = 4 Then If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ",")) Exit Function End If End If Next End Function
[/vba]
kkravets, вот так получилось: [vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) 'As Double CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD") Debug.Print url_request
If xmldoc.Load(url_request) <> True Then Exit Function Set nodeList = xmldoc.SelectNodes("*/currency") For i = 0 To nodeList.Length - 1 If nodeList.Item(i).ChildNodes.Length = 4 Then If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ",")) Exit Function End If End If Next End Function
Огромное спасибо!! Работает, однако хотел кое-что уточнить:
При использовании формулы по вышеисправленному макросу результат валюты пишется просто 8ми-значным числом без резделения запятой и в местах где котировка заканчивается на "00", например 2689.7800, подтячивается только 6-значное число без нулей, что соотвественно мешает если я хочу для получения только 4х знаков перед запятой просто сделать деление в ячейке на 100***
Чем можно в макросе поставить идентичный перенос формата числа и убрать удаление нулей?
Огромное спасибо!! Работает, однако хотел кое-что уточнить:
При использовании формулы по вышеисправленному макросу результат валюты пишется просто 8ми-значным числом без резделения запятой и в местах где котировка заканчивается на "00", например 2689.7800, подтячивается только 6-значное число без нулей, что соотвественно мешает если я хочу для получения только 4х знаков перед запятой просто сделать деление в ячейке на 100***
Чем можно в макросе поставить идентичный перенос формата числа и убрать удаление нулей?kkravets
Вот таким образом у меня отображается все. При открытии ваших файлов - все как надо. После подтвеждения включения макроса - становится все слитно.
Вот таким образом у меня отображается все. При открытии ваших файлов - все как надо. После подтвеждения включения макроса - становится все слитно.kkravets
Может быть причиной является блокировка какой-то функции средствами защиты моего рабочего компьютера в компании? (Постоянно выдается Protected View), после того я нажимаю отключить его - все также сливается в одно восьмизначное число.
Может быть причиной является блокировка какой-то функции средствами защиты моего рабочего компьютера в компании? (Постоянно выдается Protected View), после того я нажимаю отключить его - все также сливается в одно восьмизначное число.kkravets
Так у Вас Англ. офис? Попробуйте так - что выдаст?: [vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD") Debug.Print url_request
If xmldoc.Load(url_request) <> True Then Exit Function Set nodeList = xmldoc.SelectNodes("*/currency") For i = 0 To nodeList.Length - 1 If nodeList.Item(i).ChildNodes.Length = 4 Then If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then ' GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ",")) GetRate = nodeList.Item(i).ChildNodes(2).Text Exit Function End If End If Next End Function
Так у Вас Англ. офис? Попробуйте так - что выдаст?: [vba]
Код
Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False url_request = "http://bank.gov.ua/NBUStatService/v1/statdirectory/exchange?date=" + Format(RateDate, "YYYYMMDD") Debug.Print url_request
If xmldoc.Load(url_request) <> True Then Exit Function Set nodeList = xmldoc.SelectNodes("*/currency") For i = 0 To nodeList.Length - 1 If nodeList.Item(i).ChildNodes.Length = 4 Then If nodeList.Item(i).ChildNodes(3).Text = CurrencyName Then ' GetRate = CDbl(Replace(nodeList.Item(i).ChildNodes(2).Text, ".", ",")) GetRate = nodeList.Item(i).ChildNodes(2).Text Exit Function End If End If Next End Function
Работает, запятые как надо расставляет, однако при 1234.5670 и подобном - все "0" в конце все еще не отображаются. Есть ли возможность это исправить. Как я вижу уже, при формате "текст", должно отображаться все символы и 0 в том числе или есть еще способы их отобразить?
Работает, запятые как надо расставляет, однако при 1234.5670 и подобном - все "0" в конце все еще не отображаются. Есть ли возможность это исправить. Как я вижу уже, при формате "текст", должно отображаться все символы и 0 в том числе или есть еще способы их отобразить?kkravets
олжно отображаться все символы и 0 в том числе или есть еще способы их отобразить?
Поменяйте формат ячейки - поставьте числовой и разрядность увеличьте, у меня нет англ. офиса потестить не могу. или в коде попробуйте прописать вместо [vba]
олжно отображаться все символы и 0 в том числе или есть еще способы их отобразить?
Поменяйте формат ячейки - поставьте числовой и разрядность увеличьте, у меня нет англ. офиса потестить не могу. или в коде попробуйте прописать вместо [vba]