Сценарий
У меня есть книга в Excel 2010, которая рассчитывает цены на продукты на основе стоимости исходных материалов в различных валютах. Чтобы выполнить sh это, я использовал комбинацию WinHttp
, DOMDocument
, IXMLDOMNodeList
и IXMLDOMNode
для извлечения соответствующих ставок, полученных из floatrates.com . Сначала я использовал WinHttpRequest
для загрузки содержимого файла XML
из floatrates.com в DOMDocument
, используя метод DOMDocument.LoadXML
как часть самой функции. Как вы можете себе представить, это добавило много накладных расходов, с новым WinHttpRequest
каждый раз, когда вызывается функция. Чтобы обойти это, я удалил WinHttpRequest
из самой функции и вместо этого создал глобальную переменную string
для хранения содержимого XML
, вызвав WinHttpRequest
, чтобы присвоить его значение при открытии книги.
Все работает, за исключением того, что глобальная переменная, по-видимому, периодически очищается, что приводит к необходимости повторного запуска WinHttpRequest
, чтобы мои ставки правильно пересчитывали sh при пересчете.
Код
Пример XML:
<?xml version="1.0" encoding="utf-8"?>
<?xml-stylesheet type="text/xsl" href="http://www.floatrates.com/currency-rates.xsl" ?>
<channel>
<title>XML Daily Foreign Exchange Rates for U.S. Dollar (USD)</title>
<link>http://www.floatrates.com/curency/usd/</link>
<description>XML Daily foreign exchange rates for U.S. Dollar (USD) from Float Rates. Published at Sat, 21 Mar 2020 12:00:01 GMT.</description>
<language>en</language>
<baseCurrency>USD</baseCurrency>
<pubDate>Sat, 21 Mar 2020 12:00:01 GMT</pubDate>
<lastBuildDate>Sat, 21 Mar 2020 12:00:01 GMT</lastBuildDate>
<item>
<title>1 USD = 0.93217666 EUR</title>
<link>http://www.floatrates.com/usd/eur/</link>
<description>1 U.S. Dollar = 0.93217666 Euro</description>
<pubDate>Sat, 21 Mar 2020 12:00:01 GMT</pubDate>
<baseCurrency>USD</baseCurrency>
<baseName>U.S. Dollar</baseName>
<targetCurrency>EUR</targetCurrency>
<targetName>Euro</targetName>
<exchangeRate>0.93217666</exchangeRate>
<inverseRate>1.07275803</inverseRate>
<inverseDescription>1 Euro = 1.07275803 U.S. Dollar</inverseDescription>
</item>
<item>
<title>1 USD = 1.43023951 CAD</title>
<link>http://www.floatrates.com/usd/cad/</link>
<description>1 U.S. Dollar = 1.43023951 Canadian Dollar</description>
<pubDate>Sat, 21 Mar 2020 12:00:01 GMT</pubDate>
<baseCurrency>USD</baseCurrency>
<baseName>U.S. Dollar</baseName>
<targetCurrency>CAD</targetCurrency>
<targetName>Canadian Dollar</targetName>
<exchangeRate>1.43023951</exchangeRate>
<inverseRate>0.69918360</inverseRate>
<inverseDescription>1 Canadian Dollar = 0.69918360 U.S. Dollar</inverseDescription>
</item>
</channel>
В моем модуле:
Option Explicit
Global stXML as String
Function frXML(source As String) As String
Dim url As String
Dim frHttp As New WinHttp.WinHttpRequest
Dim stResult as String
url = "http://www.floatrates.com/daily/" & LCase(source) & ".xml"
frHttp.Open "GET", url
frHttp.Send
stResult = frHttp.ResponseText
Set frHttp = Nothing
frXML = stResult
End Function
В моей рабочей тетради событий:
Private Sub Workbook_Open()
stXML = frXML("USD")
End Sub
Это настраивает все для моей функции обмена валюты.
Function curXC(source As String, target As String) As Variant
Dim doc As DOMDocument
Dim nodes As IXMLDOMNodeList
Dim node As IXMLDOMNode
Dim rate As Variant
Dim irate As Variant
Dim haverate As Boolean
Dim haveirate As Boolean
haverate = False
haveirate = False
Set doc = New DOMDocument
doc.LoadXML stXML
If doc.SelectSingleNode("/channel/baseCurrency").Text = UCase(source) Then
irate = 1
Set nodes = doc.SelectNodes("/channel/item")
For Each node In nodes
If node.SelectSingleNode("targetCurrency").Text = UCase(target) Then
rate = node.SelectSingleNode("exchangeRate").Text
Exit For
End If
Next
ElseIf doc.SelectSingleNode("/channel/baseCurrency").Text = UCase(target) Then
rate = 1
Set nodes = doc.SelectNodes("/channel/item")
For Each node In nodes
If node.SelectSingleNode("targetCurrency").Text = UCase(source) Then
irate = node.SelectSingleNode("inverseRate").Text
Exit For
End If
Next
Else
Set nodes = doc.SelectNodes("/channel/item")
For Each node In nodes
If node.SelectSingleNode("targetCurrency").Text = UCase(source) Then
irate = node.SelectSingleNode("inverseRate").Text
haveirate = True
If haverate Then Exit For
ElseIf node.SelectSingleNode("targetCurrency").Text = UCase(target) Then
rate = node.SelectSingleNode("exchangeRate").Text
haverate = True
If haveirate Then Exit For
End If
Next
End If
curXC = rate * irate
End Function
Он проверяет, совпадает ли исходная или целевая валюта с базовой валютой XML, и возвращает либо обменный курс или обратный курс, где это уместно. Если ни исходная, ни целевая валюта не соответствуют базовой валюте XML, она возвращает результат умножения обратного курса исходной валюты на обменный курс целевой валюты - по существу, конвертирование из источника в базу, а затем из базы в target.
Как я уже говорил, все работает хорошо и хорошо, за исключением того, что глобальная переменная stXML
не является постоянной.
Вопрос
Почему глобальная переменная stXML
, которая устанавливается, когда книга открывается, не является постоянной в течение всего сеанса?
Чего мне не хватает, что позволило бы ей быть постоянной?
Я стараюсь не выгружать содержимое XML в ячейку или внешний файл, если это вообще возможно.
- ОБНОВЛЕНИЕ -
Благодаря комментарию На мой вопрос я смог сделать содержимое XML постоянным, по крайней мере, поэтому часть проблемы решена.
Поскольку длина строки XML превышает максимальную По длине ячейки я решил добавить объект TextBox
на скрытый лист с меткими именами «cur XML» и «hidden» соответственно. Я изменил свой код следующим образом:
События рабочей книги:
Sub Workbook_Open()
ActiveWorkBook.Sheets("hidden").Shapes.Range(Array("curXML")).TextFrame2.TextRange.Characters.Text = frXML("USD")
End Sub
Модуль:
Function curXC(source As String, target As String)
...
doc.LoadXML ActiveWorkbook.Sheets("hidden").Shapes.Range(Array("curXML")).TextFrame2.TextRange.Characters.Text
...
End Function
Это полностью исключило необходимость использования глобальной переменной.
Тем не менее, оригинальный вопрос в заголовке сообщения все еще остается без ответа. Я хотел бы выполнить ActiveWorkbook.Sheets("hidden").Shapes.Range(Array("curXML")).TextFrame2.TextRange.Characters.Text = frXML("USD")
до того, как все пересчет будет выполнен, чтобы убедиться, что у меня есть самое современное содержание XML до пересчета. Что-то вроде Sheet_Calculate()
, но для расчета для рабочей книги, чтобы он не собирал новые данные XML для каждого листа, а скорее для книги перед вычислением каждого листа.