Как сделать ссылку из интернета в эксель

Добавлено: 13.08.2017, 03:48 / Просмотров: 61334

Hugo121
Member
Откуда: Рига
Сообщений: 1546
AquaForm, возможно, но надо знать, с какого сайта нужен курс, и есть ли там такой сервис. Я думаю, Вам ведь не подойдёт курс из моей страны? AquaForm
Member
Откуда:
Сообщений: 14
Hugo121, ну мне хотя бы как пример.. курс буду брать с rbc.ru

Расскажите как у вас это происходит, а я уж по аналогии :)

Hugo121
Member
Откуда: Рига
Сообщений: 1546
Если интересно, файл с привязкой к Банку Латвии, простенько, но использую в работе.
К сообщению приложен файл (LBkurs.xls - 39Kb) cкачать Tamozhnya
Member
Откуда:
Сообщений: 121
FUNCTION GetCursesFromWeb PRIVATE i, poExcel, poActiveSheet, pcUrl, pdCusrDate, pdCurs, ta ta = CREATEOBJECT("TabloAnl") ta.first_date = DATE() ta.last_date = DATE() + 1 ta.kod_sch = sprval.ITEM IF!my_edit("CursDate",.F.,.T.) THEN RETURN.F. ENDIF poExcel = CREATEOBJECT("Excel.Application") poExcel.WorkBooks.ADD()! poExcel.ScreenUpdating=.T.! poExcel.Visible=.T. poActiveSheet = poExcel.ActiveSheet http://mirror.cbr.ru/currency_base/dynamics.asp?VAL_NM_RQ=R01035&r1=0&date_req1=01%2F09%2F2004&date_req2=02%2F09%2F2005&C_month=09&C_year=2005&rt=0&mode=1&val_name=%C0%ED%E3%EB%E8%E9%F1%EA%E8%E9+%F4%F3%ED%F2+%F1%F2%E5%F0%EB%E8%ED%E3&x=42&y=6 Запрос к серверу cbr.ru pcUrl = "URL;http://mirror.cbr.ru/currency_base/dynamics.asp?VAL_NM_RQ=R0" pcUrl = pcUrl + Get_Name("sprval", "item", "cod_cbr", ta.kod_sch) pcUrl = pcUrl + "&date_req1=" pcUrl = pcUrl + PADL(DAY(ta.first_date), 2, "0") + "%2F" pcUrl = pcUrl + PADL(MONTH(ta.first_date), 2, "0") + "%2F" pcUrl = pcUrl + PADL(YEAR(ta.first_date), 4, "0") pcUrl = pcUrl + "&r1=1&date_req2=" pcUrl = pcUrl + PADL(DAY(ta.last_date), интернета 2, "0") + "%2F" pcUrl = pcUrl + PADL(MONTH(ta.last_date), 2, "0") + "%2F" pcUrl = pcUrl + PADL(YEAR(ta.last_date), 4, "0") pcUrl = pcUrl + "&C_month=" + PADL(MONTH(ta.first_date), 2, "0") pcUrl = pcUrl + "&C_year=" + PADL(YEAR(ta.first_date), 4, "0") pcUrl = pcUrl + "&rt=0&mode=1&val_name=%C4%EE%EB%EB%E0%F0+%D1%D8%C0&x=51&y=4" WITH poActiveSheet.QueryTables.ADD(pcUrl, poActiveSheet.RANGE("A1")).WebTables = "38".REFRESH ENDWITH nStart = SECONDS() Wait_msg("Идет чтение курсов валют с сервера: cbr.ru") DO WHILE!poActiveSheet.APPLICATION.Cells[1, 1].TEXT = "Дата" AND SECONDS() - nStart < 20 ENDDO clear_wait() CREATE CURSOR tmpCurses(dCusrDate d, nCurs N(17, 4)) FOR i = 2 TO ta.last_date - ta.first_date + 2 IF EMPTY(ALLTRIM(poActiveSheet.APPLICATION.Cells[i, 1].TEXT)) LOOP ENDIF pdCusrDate = IIF(ConvPossible(VARTYPE(poActiveSheet.APPLICATION.Cells[i, 1].VALUE), "D"),; VarToVar(poActiveSheet.APPLICATION.Cells[i, 1].VALUE, "D"), {}) pdCurs = IIF(ConvPossible(VARTYPE(poActiveSheet.APPLICATION.Cells[i, 3].VALUE), "N"),; VarToVar(poActiveSheet.APPLICATION.Cells[i, 3].VALUE, "N"), 0) IF!EMPTY(pdCusrDate) AND!EMPTY(pdCurs) INSERT INTO tmpCurses(dCusrDate, nCurs) VALUES (pdCusrDate, pdCurs) ENDIF NEXT i poExcel.DisplayAlerts =.F. poExcel.QUIT msgbox("!") SELECT tmpCurses SCAN sbor_sql(GN_SERVERTYPE, "Select from spsval where date_doc =?tmpCurses.dCusrDate and kod_val =?ta.kod_sch", "tmpSpsval") IF RECCOUNT("tmpSpsval") = 0 THEN AddNewRec("Spsval", "Item", "kod_val", ta.kod_sch, "date_doc", tmpCurses.dCusrDate, "kurs", tmpCurses.nCurs) ELSE IF tmpCurses.nCurs <> tmpSpsval.kurs THEN sbor_sql(0, "Update Spsval set kurs = tmpCurses.nCurs where item = tmpSpsval.item") sbor_sql(GN_SERVERTYPE, "Update Spsval set kurs =?tmpCurses.nCurs where item =?tmpSpsval.item") ENDIF ENDIF ENDSCAN RETURN.T. ENDFUNC exp98
Member
Откуда:
Сообщений: 1003
Пользуюсь свежим вопросом, чтобы спросить.
Где-то, когда-то спёр чей-то макрос, выложенный открыто. Макрос лезет на ЦБ РФ и читает курсы валют.
Отказывается работать у меня на минибуке с вин7-начальная, зато на ХП работает безотказно. У меня ХП на большом буке. И там, и там ехсел-2003. Но и в ех-2010 под ХП работает прекрасно.

Помогите, люди добрые разобраться и исправить. Грешу на недостаток XML в моём вин7-начальн., но я не спец.
Макрос:

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) 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://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd\/mm\/yyyy") If [b]xmldoc.Load(url_request) <> True[/b] Then Exit Function ' '&#199;&#224;&#239;&#240;&#238;&#241; &#234; &#241;&#229;&#240;&#226;&#229;&#240;&#243; &#214;&#193;&#208; '' &#206;&#225;&#240;&#224;&#225;&#238;&#242;&#234;&#224; &#239;&#238;&#235;&#243;&#247;&#229;&#237;&#237;&#238;&#227;&#238; &#238;&#242;&#226;&#229;&#242;&#224; 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

Ещё даю снимок во время выполения. Видно, что собственно обращение к ЦБ возвращает не TRUE:
xmldoc.Load(url_request) <> True

Но в ХП работает, а вин7-нача - нет.
К сообщению приложен файл. Размер - 80Kb

exp98
Member
Откуда:
Сообщений: 1003
Да, с диска грузила, а с сайтов нет. Что cbr, что sql.ru

Не знаю, что произошло, но когда позагружал через меню веб-запросы, обнаружил,что и макрос заработал.
Закрыл эксел,открыл снова - работает. В общем чудеса.
Посему отбой, хотя теоретическое любопытство осталось.
Спасибо всем, кто пытался потратить время.


Источник: http://www.sql.ru/forum/759806/excel-kak-v-yacheyku-poluchit-kurs-evro-iz-interneta


Закрыть ... [X]

Excel. Подсчет и суммирование ячеек, отвечающих Свеча резная как это сделать


Как сделать ссылку из интернета в эксель Как сделать сводную таблицу в excel: пошаговая
Как сделать ссылку из интернета в эксель Как сделать прайс лист в Excel с картинками и
Как сделать ссылку из интернета в эксель Ошибка в windows 8: отказано в доступе к папке
Как сделать ссылку из интернета в эксель Путь воина Полезняшки Excel
Как сделать ссылку из интернета в эксель Хитрости Excel для всех
Как сделать ссылку из интернета в эксель 6 прибыльных бизнес-идей в сельском хозяйстве (август 2017) с
Александр Солженицын. В круге первом (т.1) Время рождает энергию, - физик Н.А.Козырев Делаем сами: Шары из ниток - Homester Занятие 9. Самостоятельно снимаем магию Как поменять местами каналы на ресивере Tриколор ТВ