курс доллара

[Евгений К.]

Добрый день.
Помогите с макросом.
У меня в исходниках цены даны в долларах, а мне нужны в рублях. Я нашел в инете макрос:

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 = Format(inpdate, "dd")   
    m = Format(inpdate, "mm")   
    y = Format(inpdate, "yyyy")   
    sURI = "http://cbr.ru/currency_base/daily.aspx?C_month=" & M & "&C_year=" _   
                  & y & "&date_req=" & d & "%2F" & M & "%2F" & y   
    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") + 87, 7)   
    Set oHttp = Nothing  
    outstr = Replace(outstr, ",", ".")   
    ActiveCell.Value = outstr   
End Sub

данный макрос дает курс доллора на опеределенную дату, но дату нужно вбивать руками... а мне нужно чтобы одним нажатием можно было подлучить курс доллара на большое количество дат.

Задача: в ячейку "СА" должен вставляться курс доллара на дату, которая стоит в ячейке "Е" и так пока не закончатся данные на странице (начинать с второй строки), т.е. одним запуском макроса должны заполниться все строки столбца "CA".

Т.о., меня бы вполне устроил выше выложенный макрос, если бы он не спрашивал меня какую мне надо дату, а сам бы смотрел ее в столбце Е в соотвествующей строке.

Зарание спасибо всем откликнувшимся!

Р.S. думаю из изложеного выше понятен мой "высокий" уровень знаний в VBA буду очень благодарен за готовый макрос или очень доходчивое объяснение

[EugeneS]

пример файла

[doober]

Можно макрос использовать как пользовательскую функцию

[аналитика]

то же самое, но процедура
кстати, как евро вырвать оттуда?

[Hugo121]

Debug.Print htmlcode

<tr><td align="right">840</td>
<td align="left">&nbsp;&nbsp;USD</td>
<td align="right">1</td>
<td>&nbsp;&nbsp;Доллар США</td>
<td align="right">30,1851</td></tr>
<tr><td align="right">978</td>
<td align="left">&nbsp;&nbsp;EUR</td>
<td align="right">1</td>
<td>&nbsp;&nbsp;Евро</td>
<td align="right">43,4605</td></tr>

Посчитал:
outstr = Mid(htmlcode, InStr(1, htmlcode, "EUR") + 81, 7)

[doober]

 outstr = Mid(htmlcode, InStr(1, htmlcode, "EUR") + 81, 7)

[аналитика]

Доллар США - 10 букв
Евро - 4 буквы
разница = 6
$

outstr = Mid(htmlcode, InStr(1, htmlcode, "USD") + 87, 7)

€

outstr = Mid(htmlcode, InStr(1, htmlcode, "EUR") + 81, 7)

[EducatedFool]

Можете попробовать мою версию функции для получения курсов валют:
http://excelvba.ru/code/CurrencyRate

или вот ещё:

http://excelvba.ru/programmes/RatesWorksheet
одно нажатие кнопки, - и в вашем файле автообновляемые курсы доллара и евро на текущую дату
(используется веб-запрос к сайту центробанка)

[аналитика]

Сообщение от EducatedFool

Можете попробовать мою версию функции для получения курсов валют:
http://excelvba.ru/code/CurrencyRate

url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd\/mm\/yyyy")

в этой строке, судя по всему, Now --> RateDate

[EducatedFool]

Сообщение от аналитика

url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd\/mm\/yyyy")

в этой строке, судя по всему, Now --> RateDate

Спасибо за поправку - как всегда, писал код в спешке)