Aktualne kursy walut w arkuszu Excela — kwerendy sieciowe w VBA

Powracam do tematyki VBA. Tym razem przerzucam się na Excela, w którym chciałem pokazać ciekawy trick, którego nauczyłem się z książki: "Excel 2007 PL. Programowanie w VBA". Pozwala on na pobranie określonej zawartości ze wskazanie strony www do naszego arkusza. Przykładowym zastosowaniem tej techniki może być aktualizowanie kursów walut w naszym arkuszu. Jeśli przykładowo posiadamy szablon faktury europejskiej, to możemy w ten sposób automatycznie przeliczyć kwotę faktury zgodnie z aktualnym kursem wybranej waluty.

Zanim zaczniemy programować

Najpierw zaprezentuję samą ideę tego rozwiązania, pokazując krok po kroku, jak pobrać dane ze strony www przy pomocy Excela. To pomoże lepiej zrozumieć cały proces pisania makra VBA.

Najpierw musimy znaleźć stronę z kursami walut. Na wstępie uprzedzam, że nie każda strona będzie się nadawać do tego celu. Aby sztuczka zadziałała, dane na stronie muszą być umieszczone w tabelach w kodzie strony. W czasach, gdy ta technika pojawiła się w Excelu, stosowanie tabel w HTMLu było powszechną techniką. Obecnie wiele stron w ogóle nie używa tego znacznika HTML, choć w HTML5 tabele wracają nieco do łask. Ja skorzystamy ze strony http://kursy-walut.mybank.pl/ Na przykładzie tej strony będzie dobrze widać sposób działania narzędzia.

Kopiujemy sobie adres strony i z zakładki "Dane" w Excelu wybieramy "Z sieci Web" w sekcji "Pobieranie danych zewnętrznych". Uruchomi to kreator kwerend sieciowych.

Pojawi się okno przeglądarki stron www. U góry wklejamy skopiowany adres strony do paska adresu i naciskamy przycisk "Przejdź", znajdujący się po prawej stronie paska adresu. Jeśli strona posiada w kodzie tabele, to są one zaznaczone w tej przeglądarce takimi żółtymi kwadracikami z czarnymi strzałkami. Po najechaniu na daną strzałkę (bez klikania) zmienia ona kolor z żółtego na zielony (turkusowy?) i dookoła tabelki, na która ona wskazuje, pojawia się niebieski obrys. To pomaga nam wybrać odpowiednią tabelę do importu. Przewijamy w dół strony do tabelkami z kursami walut i klikamy na kwadracik ze strzałką, znajdujący się w lewym górnym rogu tabeli z kursami.

W ostatnim kroku klikamy na strzałkę. Zmieni się ona w fajkę. Naciskamy przycisk "Importuj" na dole okna i wracamy do arkusza. [img=KreatorImportuj]

Pozostaje nam tylko wybrać miejsce, do którego zostaną wstawione dane ze strony. Można wstawić je do bieżącego arkusza (domyślnie w komórce, która była zaznaczona w momencie uruchomienia kreatora) lub do nowego arkusza.

I oto stało się coś magicznego. Nasz arkusz wypełnia się danymi ze strony i to z zachowaniem układu. W przypadku tej konkretnej strony dostaliśmy nawet wiersz nagłówka. A wszystko za pośrednictwem jakże prostego kreatora. Jeśli satysfakcjonuje nas taka postać danych, to przed ich wstawieniem do arkusza możemy we właściwościach zaznaczyć opcję "Odśwież dane podczas otwierania dokumentu". Dzięki temu przy każdym otwieraniu Skoroszytu, dane w naszym arkuszu będą się aktualizowały. Dzieje się tak dlatego, że kreator domyślnie zapamiętuje "parametry połączenia". Podobny efekt odświeżania uzyskamy jeśli nagramy sobie makro ze wszystkich wcześniejszych czynności rejestratorem makr, aby w przyszłości szybciej pobierać dane. Podejrzewam jednak, że import danych w takiej postaci nie jest mimo wszystko zbyt wygodny. Przede wszystkim pobiera nam się cała tabela, a w większości przypadków potrzebujemy tylko części danych, a być może nawet jednego wiersza, czy wręcz jednej komórki tej tabeli. Moglibyśmy w trakcie rejestracji makra usunąć zbędne wiersze i kolumny, co by w zasadzie załatwiło sprawę, ale jeśli z czasem ilość wierszy w tabeli na stronie ulegnie zmianie, to nasze makro przestanie działać prawidłowo. Dlatego warto nieco przerobić to makro do swoich potrzeb grzebiąc w kodzie VBA. Należy pamiętać, że makra w Excelu są zapisywane w pliku skoroszytu, a nie w szablonach, jak ma to miejsce w Wordzie. Dlatego przy zapisie dokumentu zawierającego kod VBA należy użyć rozszerzenia xlsm, a nie xlsx.

Kodujemy

Teraz, gdy wiemy już jak manualnie pobrać tabelę z kursami walut z jakiegoś serwisu internetowego, możemy ponownie wykonać te same czynności, tym razem nagrywając je rejestratorem makr. Nagrywanie rejestratorem przeważnie jest najlepszym sposobem na rozpoczęcie pisania nowego skryptu VBA. Odszukanie od podstaw wszystkich potrzebnych metod i właściwości zajęłoby nam masę czasu. Ja wstawię pobrane dane do nowego arkusza. Dzięki temu pobrane dane nie zniszczą mi dokumentu, do którego chcę wstawić kurs waluty. Dodatkowo ułatwi to przetwarzanie danych w VBA, ponieważ będę mieć pewność, że dane zawsze zaczynają się w komórce A1. Otrzymałem następujący kod VBA:

ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://kursy-walut.mybank.pl", Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = "kursy-walut.mybank.pl"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

Kod jest w zasadzie całkiem prosty. Prawie całość to zapisane ustawienia z przycisku "Właściwości", o którym wspominałem już wcześniej. Jeśli coś w oknie właściwości ma zaznaczonego checkboxa, to w kodzie będzie miało wartość true.

Uproszczenie kodu

W tym miejscu muszę koniecznie zwrócić uwagę na właściwość CommandType. Należy ją koniecznie usunąć z kodu, ponieważ jej obecność generuje błąd. Jest ona używana do innego rodzaju połączeń, np. do pobierania tabel baz danych. Być może jest to błąd generatora kodu VBA. W książce, która wspominałem, autorzy nie używają tej właściwości.

Tak naprawdę większość z tych parametrów jest niepotrzebna. Dotyczą one głównie formatowania komórek z wstawionymi danymi. Ponieważ my będziemy te dane wstawiać jedynie tymczasowo, to absolutnie nie ma to dla nas żadnego znaczenia. Kluczową właściwością, która musi się znaleźć jest "WebTables", która określa, która tabelę ze strony chcemy pobrać. W tym konkretnym przypadku ma ona wartość 7, ponieważ na stronie, a raczej w jej kodzie, znajduje się przed nią 6 innych tabel. Warto także zostawić linijkę .Refresh BackgroundQuery:=False. Ostatecznie zredukowany kod ma postać:

ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://kursy-walut.mybank.pl", Destination:=Range("$A$1"))
        .WebTables = "7"
        .Refresh BackgroundQuery:=False
    End With

Pierwsze modyfikacje

Ponieważ nasze importowane dane wstawiane są do nowego arkusza, dobrze byłoby go jakoś nazwać lub przypisać do zmiennej, aby jednoznacznie się do niego odwoływać. Nasz kod nie wie ile do tej pory było arkuszy i w którym miejscu został wstawiony nowy arkusz. Prawdopodobnie dałoby się to ustalić, ale najprościej jest po prostu przypisać do zmiennej tworzony arkusz. W tym celu zastępujemy pierwszą instrukcję naszego kodu następującymi dwoma:

Dim tmp As Worksheet
Set tmp = ActiveWorkbook.Worksheets.Add

Pierwsza linijka to deklaracja nowej zmiennej, która będzie przechowywać obiekt typu Worksheet, czyli arkusz. Druga linijka to przypisanie nowe tworzonego arkusza do naszej zmiennej. W następnej linijce możemy zastąpić ActiveSheet baszą zienną.

Wyszukanie interesujących nas danych

Powiedzmy, że z zaimportowanej tabeli kursu walut interesuje nas jedynie kurs Euro. Pokaże dwa sposoby na wyciągnięcie tylko kursu Euro z zaimportowanej tabeli. Najprościej taki problem jest rozwiązać odczytując sekwencyjnie dane w tabeli. Zupełnie tak, jak robimy to wizualnie. Pierwszy sposób to zastosowanie pętli for. Pętla for wykonuje te same instrukcje z góry określoną ilość razy. W naszym przypadku ilość iteracji (powtórzeń) będzie równa ilości wierszy w tabeli. Aby określić ilość zapisanych wierszy w arkuszu użyjemy składni, która prezentowałem w poprzednim wpisie o VBA.

Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row

W przypadku naszej tabeli możemy sprawdzać pierwszą lub drugą kolumnę, ponieważ obie odnoszą się do waluty. Moim zdaniem prościej jest analizować drugą kolumnę, bo znajdują się w niej prostsze wyrażenia, bez polskich znaków, aczkolwiek w większości przypadków nie robi to różnicy.

For i = 1 To LastRow
   If (tmp.Cells(i, 2).Value = "1 EUR") Then
      Kurs = tmp.Cells(i, 3).Value
   End If
Next i

W każdym kroku pętli sprawdzamy wartość komórki o adresie i, 2. Pierwszy parametr Cells to wartość "i", która oznacza numer wiersza komórki. Dla każdej iteracji jest ona inna i zmienia się od 1 do LastRow, czyli ilości zapisanych wierszy. Drugi parametr to numer kolumny - jest on stały i wynosi 2, bo analizujemy drugą kolumnę. Jeśli wartość sprawdzanej komórki to "1 EUR", oznacza to, iż trafiliśmy na właściwą komórkę. Znając numer wiersza możemy się w tym samym kroku pętli odnieść do komórki w 3‑ciej kolumnie, która przechowuje kurs Euro. Zapisujemy tę wartość do zmiennej Kurs. Zmienną Kurs musimy uprzednio zadeklarować jako łańcuch znaków (String). Ponieważ Excel i VBA są amerykańskie, jako separatora dziesiętnego używają kropki, a nie przecinka. Dlatego musimy w naszej zmiennej zamienić przecinek na kropkę.

Kurs = Replace(Kurs, ",", ".")

Tak wyłuskaną wartość możemy wstawić do naszego arkusza w odpowiednie miejsce. Zanim jednak do tego przejdę, chciałbym pokazać drugi typ pętli, który w tym przypadku jest bardziej efektywny.

Tak się składa, że Euro jest drugą walutą w tabeli i niepotrzebnie sprawdzaliśmy pozostałe wiersze tabeli. W przypadku 30 wierszy nie stanowi to problemu, ale gdybyśmy pobierali dużo większą tabelę, to zastosowanie pętli for mogłoby spowodować znaczące spowolnienie działania. Dlatego warto użyć pętli until. Pętla until nie musi mieć określonej liczyb powtórzeń. Będzie ona powtarzać instrukcje tak długo, aż zadany warunek wyjścia z pętli zostanie spełniony. W VBA taka pętla ma następującą postać:

Do 
   Instrukcje
Loop Until (warunek wyjścia)

Można to przetłumaczyć jako: wykonuj zestaw instrukcji, aż warunek zostanie spełniony. W naszym przypadku warunkiem wyjścia z pętli będzie napotkanie komórki o wartości "1 EUR". Jak zapewne zauważyliście, pętla do until nie posiada zmiennej sterującej i, przez co nie możemy odnosić się do kolejnych wierszy tabeli. Musimy więc sami utworzyć sobie taką zmienną i nadać jej wartość początkową przed rozpoczęciem pętli, a następnie wewnątrz pętli zwiększać jej wartość o 1. Pętla for robi to automatycznie za nas i w tym sensie jest prostsza, ale jednocześnie bardziej ułomna bo wykonuje się z góry zadaną ilość razy.

i = 0
Do
i = i + 1   
   If (tmp.Cells(i, 2).Value = "1 EUR") Then
      Kurs = tmp.Cells(i, 3).Value
   End If
Loop Until (tmp.Cells(i, 2).Value = "1 EUR")

Tak zbudowana pętla w zasadzie zrobi swoje, aczkolwiek możemy mieć z nią problem w sytuacji, gdy w całej tabeli nie znajdziemy wartości "1EUR". Pętla kręciłaby się w nieskończoność. W starym Excelu dojechałaby do końca arkusza i wyrzuciła błąd zakresu (próby odwołania do nieistniejącej komórki), natomiast w nowszych wersjach być może zanim by dojechała do końca, to Excel wyrzuciłby komunikat, że program nie odpowiada. Dlatego gdy używamy pętli do while i do until zawsze musimy zbudować sobie zawór bezpieczeństwa na wypadek, gdyby nasz warunek nigdy nie został spełniony. Musimy dodać drugi warunek wyjścia, który na pewno zostanie spełniony. Najprościej jest ustawić maksymalny zakres takiej pętli. W naszym przypadku możemy kazać opuścić pętle, jeśli zmienna sterująca osiągnie wartość równą zmiennej LastRow. Dzięki temu pętla zakończy się po sprawdzeniu wszystkich zapełnionych wierszy.

i = 0
Do
   i = i + 1
   If (tmp.Cells(i, 2).Value = "1 EUR") Then
      Kurs = tmp.Cells(i, 3).Value
   End If
Loop Until ((tmp.Cells(i, 2).Value = "1 EUR") Or (i = LastRow))

Jeśli chcemy się upewnić, że pętla faktycznie wyskakuje po znalezieniu Euro, możemy sobie dopisać po instrukcji zwiększania wartości i polecenie: Debug.Print i. Wyświetli ono nam w immediate window (CTRL+G) kolejne wartości i. Zobaczymy, że najwyższa wartość i to 3, bo Euro znajduje się w trzecim wierszu.

Wstawienie kursu do arkusza docelowego

Najprościej jest utworzyć kolejną zmienną, do której przypiszemy nasz arkusz docelowy. Ja swój nazwałem "Faktura". Kurs Euro będę wstawiać do komórki A2.

Dim Faktura As Worksheet
Set Faktura = ActiveWorkbook.Sheets("Faktura")
Faktura.Cells(1, 2).Value = Kurs

Pozostaje nam tylko po sobie posprzątać, czyli usunąć ze skoroszytu arkusz tymczasowy.

Application.DisplayAlerts = False
tmp.Delete
Application.DisplayAlerts = True

DisplayAlerts sprawi, że nie wyświetli się monit proszący o potwierdzenie, czy chcemy usunąć niepusty arkusz.

Efekt końcowy

Cały kod ma następującą postać:

Sub Euro()
Dim tmp As Worksheet
Dim Faktura As Worksheet
Dim i As Integer
Dim LastRow As Long
Dim Kurs As String

Set tmp = ActiveWorkbook.Worksheets.Add
Set Faktura = ActiveWorkbook.Sheets("Faktura")
Application.DisplayAlerts = False
On Error Resume Next
Sheets("TMP").Delete
Application.DisplayAlerts = True

tmp.Name = "TMP"
With tmp.QueryTables.Add(Connection:= _
    "URL;http://kursy-walut.mybank.pl", Destination:=Range("$A$1"))
    .WebTables = "7"
    .Refresh BackgroundQuery:=False
End With

LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 0
Do
   i = i + 1
   If (tmp.Cells(i, 2).Value = "1 EUR") Then
      Kurs = tmp.Cells(i, 3).Value
   End If
Loop Until ((tmp.Cells(i, 2).Value = "1 EUR") Or (i = LastRow))
Kurs = Replace(Kurs, ",", ".")
Faktura.Cells(1, 2).Value = Kurs
Application.DisplayAlerts = False
tmp.Delete
Application.DisplayAlerts = True
End Sub

U mnie wykonuje się w przeciągu 1 sekundy.

Podsumowanie

Pokazana technika może mieć bardzo szerokie zastosowanie. Pobierać możemy dowolne dane, o ile znajdują się one w tabeli. Jeśli kreator nie widzi tabel na jakiejś stronie, można próbować policzyć samemu tabele na stronie i wstawić w kodzie odpowiednią wartość. Życzę udanej zabawy z kwerendami sieciowymi.