Strona używa cookies (ciasteczek). Dowiedz się więcej o celu ich używania i zmianach ustawień. Korzystając ze strony wyrażasz zgodę na używanie cookies, zgodnie z aktualnymi ustawieniami przeglądarki.    X

Automatyzacja pracy z Wordem — import danych adresowych z Excela

W dzisiejszym wpisie chciałbym pokazać w jaki sposób można pobierać i wstawiać do Worda dane zewnętrzne. Niniejszy przykład jest z pewnością zaledwie jednym z wielu możliwych sposobów na zrealizowanie takiego zdania. Ma on swoje ograniczenia (dobry do stosunkowo niewielkiej ilości danych). Zaznaczam również, że nie należy traktować moich wpisów na zasadzie sztywnej instrukcji obsługi VBA. Pragnę jedynie zademonstrować szerokie spektrum zastosowań tego niedocenianego składnika Office'a, a przy okazji podpowiedzieć jak się można zabrać za wykonanie pewnych rzeczy. Na każdym etapie podawanego przeze mnie rozwiązania, można zastosować jakiś inny sposób i dostosować całość do swoich potrzeb.

Przygotowanie dokumentu do importu danych

Na początek przygotuję w dokumencie Worda miejsce, do którego będę wstawiać dane. W tym celu, w miejscu gdzie mają się znajdować dane adresata, z zakładki Deweloper wstawiam formant zawartości. Ja użyłem list rozwijanych. Aby edytować poszczególne listy trzeba włączyć tryb projektowania na wstążce a następnie stojąc na wybranej liście nacisnąć ze wstążki właściwości. W zależności do potrzeb i typu importowanych danych można nadać tytuły poszczególnym listom. Ja swoje nazwałem: adresat, ulica, miejscowość. W dalszej części pokażę w jaki sposób manipulować zawartością tych pól z poziomu VBA,

Przygotowanie danych w Excelu

Po stronie Excela wprowadzam dane kilku przykładowych adresatów. Dla uproszczenia kodu VBA, każdą cząstkę danych, która ma zostać wstawiona do danej listy rozwijanej Worda, wpisuję w oddzielną kolumnę w Excelu. Zapisuję tak przygotowany skoroszyt.

Uzyskanie dostępu do danych ze skoroszytu

Zanim zaczniemy cokolwiek pisać w edytorze VBA musimy uzupełnić brakujące zależności. W tym celu z okna Tools edytora VBA wybieramy "References..." i tam zaznaczamy Microsoft Excel Library. Bez tej biblioteki nie będziemy w stanie kontrolować aplikacji Excela.

Teraz nasz model obiektowy wzbogacił się o klasy reprezentujące Excela i jego elementy. W kodzie zaczniemy od zdefiniowania tych elementów. Będzie to sama aplikacja Excela oraz skoroszyt i arkusz. Warto też zapisać sobie do zmiennej ścieżkę do skoroszytu z adresami.

Dim xlApp As New Excel.Application Dim wb As Excel.Workbook Dim sh1 As Excel.Worksheet Dim wbPath As String Set xlApp = CreateObject("Excel.Application") xlApp.Visible = False wbPath = "C:\Users\MojaFirma\Desktop\adresy.xlsx" Set wb = xlApp.Workbooks.Open(wbPath) Set sh1 = wb.Sheets(1)

Aplikacja Excela jest ustawiona jako niewidoczna. Oznacza to, że jeśli makro VBA będzie otwierać skoroszyt Excela, to nie zobaczymy tego (co najwyżej w procesach). Dzięki temu całość wykona się wielokrotnie szybciej. Zbudowanie interfejsu graficznego zajmuje masę czasu w porównaniu z samym otworzeniem dokumentu i odczytaniem z niego danych. Używany arkusz zdefiniowałem odwołując się do numeracji arkuszy w skoroszycie, ale równie dobrze można wskazywać arkusze za pomocą ich nazw.

Przygotowanie do iteracji na wierszach

Tworzymy kilka zmiennych pomocniczych, którymi posłużymy się przy odczycie danych ze skoroszytu:

LastRow - będzie przechowywać ilość niepustych wierszy w arkuszu - dzięki temu będziemy mieli pewność, że odczytujemy tylko te wiersze, w których są zapisane dane;

i - zmienna sterująca pętlą, której zadaniem będzie przeskakiwanie po wierszach arkusza;

Adresaci - tablica zawierające odczytane dane z kolumny adresatów;

Ulice - analogicznie tablica z odczytanymi ulicami;

Miejscowosci - odczytane miejscowosci;

Aby ustalić ilość niepustych wierszy użyjemy następującego kodu:Dim LastRow As Long Dim i As Integer Dim Adresaci() As String Dim Ulice() As String Dim Miejscowosci() As String LastRow = Range("A" & Rows.count).End(xlUp).Row If (LastRow = 1) Then xlApp.Quit Set wb = Nothing Set xlApp = Nothing Exit Sub End If

Przy okazji sprawdzamy ile jest tych wierszy. Jeśli tylko jeden, to oznacza, że poza wierszem nagłówka nie ma żadnych danych i dalsze wykonywanie instrukcji nie ma sensu. Zamykamy Excela, czyścimy zmienne, aby nie zajmowały niepotrzebnie pamięci i przerywamy dalsze działanie makra.

Określenie rozmiaru tablic dynamicznych

Tablice, w których będziemy zapisywać odczytane dane zostały zadeklarowane jako tablice dynamiczne. Oznacza to, że nie podaliśmy ich rozmiaru (ilości przechowywanych elementów). W VBA istnieje możliwość zmiany wielkości tablicy w trakcie wykonywania kodu. Ponieważ obecnie wiemy, ile wierszy odczytamy, możemy ustalić rozmiar naszych tablic. Jest to konieczne przed rozpoczęciem iteracji, ponieważ nie ma możliwości odnoszenia się do tablic, które nie mają zdefiniowanego rozmiaru.

ReDim Adresaci(1 To LastRow - 1) As String ReDim Ulice(1 To LastRow - 1) As String ReDim Miejscowosci(1 To LastRow - 1) As String

Rozmiar tablic jest mniejsza o 1 od ilości zapisanych wierszy, ponieważ pomijamy pierwszy wiersz, będący nagłówkiem. Oczywiście jeśli ktoś nie chce używać nagłówka, możemy nie odejmować tego jednego elementu.

Iteracja i odczyt danych

Naszą pętle ustawiamy tak, aby pierwszy odczytywany wiersz miał indeks = 2. Pomijamy w ten sposób pierwszy wiersz, będący nagłówkiem.

For i = 2 To LastRow Adresaci(i - 1) = sh1.Cells(i, 1).Value Ulice(i - 1) = sh1.Cells(i, 2).Value Miejscowosci(i - 1) = sh1.Cells(i, 3).Value Next i

Obiekt Cells reprezentuje komórki arkusza. Tak naprawdę jest to dwuwymiarowa tablica komórek arkusza (tablica, której elementami są jednowymiarowe tablice takie, jak np. Adresaci). Aby wskazać konkretną komórkę skoroszytu podajemy kolejno numer wiersza i numer kolumny. W miejsce numeru wiersza wstawiamy zmienną sterującą pętli "i", która dla każdego przebiegu pętli ma wartość zwiększaną o 1, począwszy od 2, a skończywszy na wartości równej ilości niepustych wierszy w arkuszu.

Jeśli chcemy sprawdzić działanie naszej pętli, zanim przejdziemy do wstawiania danych do dokumentu Worda, możemy dopisać do pętli instrukcję wyświetlenia zawartości naszych tablic do immediate window (włączanego w edytorze VBA skrótem ALT+G).Debug.Print (Adresaci(i - 1)) Debug.Print (Ulice(i - 1)) Debug.Print (Miejscowosci(i - 1))

Gdy już mamy wszystkie dane, możemy zamknąć Excela tym samym kodem, którego używaliśmy wcześniej. Przechodzimy teraz do sterowania listami rozwijanymi w Wordzie.

Przypisanie list rozwijanych do zmiennych VBA

Aby zapełnić danymi poszczególne listy, najpierw trzeba je sobie zdefiniować w kodzie VBA, aby zyskać do nich dostęp i kontrolę. Wszystkie formanty zawartości są w VBA reprezentowane przez obiekty klasy ContentControl. Zatem:Dim PoleAdresata As ContentControl Dim PoleUlicy As ContentControl Dim PoleMiejscowosci As ContentControl

Jeśli nasz dokument zawiera tylko te 3 listy, to możemy się do nich dostać po indeksach (są one kolejno numerowane):PoleAdresata = ActiveDocument.ContentControls.Item(1) PoleUlicy = ActiveDocument.ContentControls.Item(2) PoleMiejscowosci = ActiveDocument.ContentControls.Item(3)

Jeśli jednak korzystamy w dokumencie z innych elementów tego typu, to lepiej nie ryzykować pomieszania numeracji i zidentyfikować nasze listy po tytule, który wcześniej nadaliśmy. W tym celu wykonamy pętlę po wszystkich elementach typu ContentControl i dla każdego z osobna sprawdzimy jego tytuł. Jeśli natrafimy na element o pasującym tytule, przypiszemy go do naszej zmiennej. Jest to bardziej rozbudowana metoda, ale zyskujemy pewność, że nasze zmienne odnoszą się do właściwych elementów w dokumencie. Aby skonstruować pętlę for, musimy ustalić ilość elementów ContentControl w dokumencie. Najwygodniej jest zapisać tę informację do zmiennej.Dim IlePol As Integer IlePol = ActiveDocument.ContentControls.count

Teraz sprawdzamy wszystkie formanty:Dim Tytul As String For i = 1 To IlePol Tytul = ActiveDocument.ContentControls.Item(i).Title Select Case Tytul Case "Adresat" Set PoleAdresata = ActiveDocument.ContentControls.Item(i) Case "Ulica" Set PoleUlicy = ActiveDocument.ContentControls.Item(i) Case "Miejscowość" Set PoleMiejscowosci = ActiveDocument.ContentControls.Item(i) End Select Next i

W każdym kroku pętli zmiennej tytuł przypisujemy tytuł kolejnego sprawdzanego elementu typu ContentControl. Następnie korzystamy z konstrukcji Select Case. Jest to odpowiednik instrukcji warunkowej If Then Else, która jest łatwiejsza w stosowaniu, jeśli mamy do czynienia z wieloma przypadkami do rozpatrzenia. Odpowiednikiem warunku, który sprawdzamy w konstrukcji If, jest to, co stoi po Select Case. W naszym przypadku jest to Tytul. Każdy Case poniżej wskazuje na możliwą wartość zmiennej Tytul, jaką może ona przyjąć oraz instrukcję jaka ma być wykonana, jeśli sprawdzana wartość zmiennej tytuł będzie się zgadzać z tą podaną w danym Case. Jeśli więc napotkamy na element ContentControl o tytule "Adresat" to wykonana zostanie instrukcja przypisania tego elementu do zmiennej Adresat. W ten sposób możemy wyłapać wszystkie nasze elementy po tytule, bez względu na to jaki mają swój "numerek" w zbiorze formantów zawartości (ContentControls).

"Zaludnianie" list rozwijanych

Wypełnianie danymi różnych elementów, np. listy rozwijanej jest zwane w VBA zaludnianiem. Warto znać to określenie, ponieważ są w VBA polecenia, które dosłownie tak brzmią. Mając już zmienne przechowujące odpowiednie listy możemy stworzyć pętlę, która wypełni nam te listy danymi. Pozostaje nam jeszcze tylko upewnić się, że listy nie przechowują jakichś starych danych. W tym celu należy je wyczyścić.PoleAdresata.DropdownListEntries.Clear PoleUlicy.DropdownListEntries.Clear PoleMiejscowosci.DropdownListEntries.Clear

Wyczyszczone listy są gotowe do zapełnienia.

For i = 1 To UBound(Adresaci) PoleAdresata.DropdownListEntries.Add Adresaci(i) PoleUlicy.DropdownListEntries.Add Ulice(i) PoleMiejscowosci.DropdownListEntries.Add Miejscowosci(i) Next i

Funkcja Ubound (Upper Bound) zwraca nam ilość elementów tablicy. Jako parametr przyjmuje tablicę, której ilość elementów ma policzyć. Dzięki temu możemy ustawić odpowiednią (zgodną z ilością odczytanych wierszy w Excelu) ilość kroków pętli.

Optymalizowanie kodu

W tym przykładzie celowo użyłem zmiennych, które są tak naprawdę zbędne, a wiele operacji można było wykonać w jednej pętli zamiast w kilku. Zrobiłem tak, aby łatwiej można było zrozumieć co się dzieje w poszczególnych miejscach i nie robić zbyt wiele na raz. Zapełnianie list można zrobić od razu w pętli odczytu danych z Excela bez konieczności tworzenia tablic, w których te dane są przechowywane. Poniżej zamieszczam cały kod makra, w skróconej wersji.Sub ImportExcel() '-----ZMIENNE DO EXCELA------------ Dim xlApp As New Excel.Application Dim wb As Excel.Workbook Dim sh1 As Excel.Worksheet Dim wbPath As String Dim LastRow As Long Dim i As Integer '-----ZMIENNE DO WORDA------------ Dim PoleAdresata As ContentControl Dim PoleUlicy As ContentControl Dim PoleMiejscowosci As ContentControl Dim IlePol As Integer Dim Tytul As String '-----PRZYGOTOWANIE LIST DO ZAPELNIENIA---------------------- IlePol = ActiveDocument.ContentControls.count For i = 1 To IlePol Tytul = ActiveDocument.ContentControls.Item(i).Title Select Case Tytul Case "Adresat" Set PoleAdresata = ActiveDocument.ContentControls.Item(i) Case "Ulica" Set PoleUlicy = ActiveDocument.ContentControls.Item(i) Case "Miejscowość" Set PoleMiejscowosci = ActiveDocument.ContentControls.Item(i) End Select Next i PoleAdresata.DropdownListEntries.Clear PoleUlicy.DropdownListEntries.Clear PoleMiejscowosci.DropdownListEntries.Clear '-----OTWORZENIE SKOROSZYTU I SPRAWDZENIE ILOSCI WIERSZY--------- Set xlApp = CreateObject("Excel.Application") wbPath = "C:\Users\Jarosław\Desktop\adresy.xlsx" Set wb = xlApp.Workbooks.Open(wbPath) xlApp.Visible = False Set sh1 = wb.Sheets(1) LastRow = Range("A" & Rows.count).End(xlUp).Row If (LastRow = 1) Then xlApp.Quit Set wb = Nothing Set xlApp = Nothing Exit Sub End If '-----ODCZYT DANYCH I ZAPIS DO LIST W WORDZIE------------- ReDim Adresaci(1 To LastRow - 1) As String ReDim Ulice(1 To LastRow - 1) As String ReDim Miejscowosci(1 To LastRow - 1) As String For i = 2 To LastRow PoleAdresata.DropdownListEntries.Add sh1.Cells(i, 1).Value PoleUlicy.DropdownListEntries.Add sh1.Cells(i, 2).Value PoleMiejscowosci.DropdownListEntries.Add sh1.Cells(i, 3).Value Next i xlApp.Quit Set wb = Nothing Set xlApp = Nothing End Sub

Jak widać na zrzucie ekranu poniżej, w treści dokumentu nie wyświetlają się zaimportowane dane. Są one widoczne dopiero po rozwinięciu listy. Dzieje się tak dlatego, że domyślnie ustawiony jest indeks 0, a więc żaden element listy nie jest wybrany.

Można to zmienić i ustawić np. pierwszy element w następujący sposób:PoleAdresata.DropdownListEntries.Item(1).Select

Podsumowanie

W niniejszym wpisie pokazałem na przykładzie jak można pobierać dane z Excela i wstawiać je do Worda. Każdy może poeksperymentować i zmodyfikować podane przeze mnie rozwiązanie. Nie ma konieczności stosowania rozwijanych list. Są one jednak wygodne, ponieważ w łatwy sposób możemy zdefiniować je w kodzie VBA i wstawić dane dokładnie w to miejsce w tekście, które nas interesuje. Na wydruku listy rozwijane z wybranymi wartościami wyglądają jak zwykły tekst.

Bazę adresów w Excelu możemy na bieżąco aktualizować. Jeśli nasze makro wstawimy do makra AutoOpen lub Document_Open to nasze listy będą się aktualizować przy każdym otworzeniu dokumentu. Adresy możemy posortować alfabetycznie. Najprościej w samym Excelu, po dodaniu nowych wpisów, choć można to zrobić także z poziomu VBA.  

windows porady programowanie

Komentarze

0 nowych
Vidivarius   13 #1 07.11.2014 17:53

k@kaisujWidzę, że idziesz jak burza z tymi wpisami :) Ja tam się cieszę - są bardzo ciekawe i dużo wnoszące.
Proszę tylko - nie strać zapału.
Może coś o makrach z automatycznymi korektami typu twarda spacja po spójnikach, skrótach itp., osuwanie ręcznego podziału wiersza w miejscach naruszających ciągłości akapitu itp. W prawdzie mam na to sposoby, ale obawiam się, że daleko im do doskonałości i fachowości jaką prezentujesz.

kaisuj   10 #2 07.11.2014 18:15

@Vidivarius: Kiedyś pisałem makro na automatyczne przenoszenie pojedynczych znaków z końca linii do następnej linii, właśnie z wykorzystaniem twardej spacji. Niestety mam uszkodzone archiwum z tym kodem i nie mogę tego odzyskać. Musiałbym napisać od nowa. Jeśli znajdę czas i poszłoby mi to na tyle dobrze, że byłoby czym się pochwalić, to mogę wrzucić coś takiego. W zasadzie od ponad 2 lat nie zajmuję się już VBA, więc nie mając zapisu swojego dorobku, muszę sobie sporo odświeżać i przypominać pewne szczegóły.
Swoją drogą to zwróć uwagę jakim zainteresowaniem cieszą się wpisy o VBA. A wystarczy napisać, że Windows jest do d**y, a Linux jest lepszy i już dostajesz 100 komentarzy w ciągu 2 dni:)

floyd   14 #3 07.11.2014 18:40

@kaisuj: ". A wystarczy napisać, że Windows jest do d**y, a Linux jest lepszy i już dostajesz 100 komentarzy w ciągu 2 dni:)"
A, jak byś pisał o PiSie i PO, a może o katastrofie smoleńskiej, to było by jeszcze więcej wpisów, ale czy o to chodzi?
Po prostu merytoryczny wpis nie budzi kontrowersji i dlatego jest mniej komentarzy. Kiedyś sugerowałem aby tworzyć tego typu teksty i bardzo dobrze, ze poszedłeś tą drogą. Myślę, że z czasem mogą się cieszyć dużą popularnością, choć komentarzy nie musi być zbyt wiele.

t0ken   8 #4 07.11.2014 22:03

Solidny wpis. Dziękuję.

kaisuj   10 #5 07.11.2014 23:47

@Vidivarius: Przemyślałem sprawę twardych spacji i usuwania sierot z dokumentu. Wydaje mi się, że nie ma potrzeby pisania makra VBA, które by się tym zajmowało. Szybciej jest po prostu pozamieniać systemowo (CTRL+H) spójniki otoczone spacjami (np. " i ") na analogiczne wyrażenia, ale z twardymi spacjami. Okienko zamiany ma możliwość wprowadzania znaków specjalnych za pomocą "kodów". Kodem dla twardej spacji jest "^s", tak więc spójnik "i" otoczony tymi spacjami będzie miał postać "^si^s" . Oczywiście można zrobić sobie makro, które za jednym pociągnięciem zamieni wszystkie możliwe spójniki, ale tego nie trzeba nawet pisać. Wystarczy sobie nagrać rejestratorem makr. Do usuwania wdów jest w Wordzie specjalnej ustawienie w ustawieniach akapitu: http://praktykatrenera.pl/wp-content/uploads/2010/12/przenoszenielinii2.jpg

Autor edytował komentarz.
Vidivarius   13 #6 08.11.2014 10:36

@kaisuj
Oczywiście to o czym piszesz jest mi znane. Chodzi jednak o masowe i wielokrotne stosowanie tej funkcji, a nie sporadycznie. Gdy w pracy na 20 dokumentach trzeba powstawiać twardą spację po każdym spójniku, przed lub po każdym skrócie. Gdy trzeba naprawić całe akapity "poszatkowane" ręcznymi podziałami wiersza - przełamania w niewłaściwych miejscach jak np. po imporcie z PDFa. Gdy trzeba dywizy zamienić na półpauzy lub odwrotnie. Gdy trzeba pousuwać spacje przy dywizach. I tak dalej, wielokrotnie.

yuwo   7 #7 08.11.2014 12:42

No to czekają mnie 4 dni testowania :-)

  #8 10.11.2014 13:50

Witam,
moje makro na usuwanie spójników na końcach wierszy (właściwie to makro dodaje twardą spację po każdym wyrazie jednoliterowym). Makro podpiąłem pod dodany do paska przycisk i można używać do woli. Makro jest "napisane" rejestratorem dla pojedynczego przykładu i powielone dla pozostałych. Na pewno ma sporo nadmiarowego kodu.

Sub samotnicy()
'
' samotnicy
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " w "
.Replacement.Text = " w "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " z "
.Replacement.Text = " z "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " a "
.Replacement.Text = " a "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " i "
.Replacement.Text = " i "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " u "
.Replacement.Text = " u "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

kaisuj   10 #9 10.11.2014 19:24

@Anonim (niezalogowany): Twoje makro to jest to, o czym pisałem, czyli automatyczna zamiana wyrażeń. Testowałeś ten kod, bo na oko wydaje mi się błędny, ale mogę się mylić.

  #10 12.11.2014 13:16

Kod przetestowany - zawsze jak otwieram jakiś dokument to klikam przycisk z przypisanym makrem "samotnicy"; nigdy nic się nie działo. Dzisiaj dodałem funkcję dla litery "o". Zresztą możesz skopiować kod i sprawdzić.
Ja używam Office 2007.

  #11 01.03.2016 22:06

Bardzo pomógł mi Twój poradnik, jedyne czego mi zabrakło to kodu aby w momencie wybrania adresata automatycznie uzupełniały się dwa pozostałe pola, czy jest na to jakiś sposób?

kaisuj   10 #12 02.03.2016 17:40

@Nozema (niezalogowany): Dawno już w VBA nie robiłem i nie mam plików źródłowych, ale w wolnej chwili zajrzę do tego i spróbuję dopisać. Pierwsza rzecz jaka przychodzi mi do głowy to zrobienie procedury obsługującej zdarzenie zmiany zaznaczenia elementu pierwszej listy, w której to ustawimy indexy pozostałych list. Czyli procedura ta będzie reagować (wykonywać swój kod) w momencie, gdy zmienisz wartość na pierwszej liście (adresata). W kodzie tym zrobisz na dropdownie ulicy i miejscowości select na index odpowiadający indexowi, który się zmieni w dropdownie adresata. Czyli jeśli zmieni się index adresata z 1 na 2, to pozostałe dropdowny też ustawiasz na 2. Dla zachowania spójności danych można analogicznie zrobić z pozostałymi dropdownami.

Autor edytował komentarz.
  #13 16.10.2016 10:34

mi błąd wyskakuje na LastRow = Range("A" & Rows.Count).End(xlUp).Row coś nie działa