Przeglądarka zdjęć w Excelu

W czasie dwóch prowadzonych szkoleń z VBA dla Excel w Krakowie i Wrocławiu padło pytanie o możliwość stworzenia czegoś na wzór przeglądarki zdjęć w Excelu w oparciu o nazwy plików graficznych umieszczonych w kolumnie arkusza.

Oczywiste pytanie, które również zadałem brzmiało- po co i dlaczego mielibyśmy tworzyć takie rozwiązanie? Jak się okazało, i tu będę bazował na podobnych elementach uzyskanych odpowiedzi, chodziło o szybką i skuteczną weryfikację jak wygląda dany produkt w bazie produktów danej firmy.

Poniżej przedstawiam wariant uproszczony przygotowany w trzech krokach. Wszelkie modyfikacje i rozszerzenia są jak najbardziej możliwe i zalecane.

Krok 1. Tworzymy listę plików graficznych. 
W tym celu w komórce A1 dowolnego arkusza proszę wprowadzić ścieżkę do katalogu, w którym znajdują się nasze pliki graficzne, np: c:\Users\Imię Naziwsko\Documents\Moje obrazy.

Następnie proszę wywołać poniższe makro, którego celem będzie utworzenie listy wszystkich plików graficznych JPG począwszy od rzędu 11 w kolumnie A.

view sourceprint?

01	Sub ListaPlikowKatalogu_All()

02

03	'instrukcja działa dla katalogu określonego jako bieżący

04	ChDir ActiveSheet.Cells(1, 1)

05

06	Dim TMP As String

07	Dim Wiersz As Integer

08	Wiersz = 11

09	'inicjacja kryterium nazwy- pliki JPG

10	Cells(Wiersz, 1) = Dir("*.jpg")

11

12

Do

13	Wiersz = Wiersz + 1

14	TMP = Dir()

15	Cells(Wiersz, 1) = TMP

16

17	Loop While TMP <> ""

18

19	Cells(10, 1).Select

20

End Sub

Krok 2.  Wstawianie i usuwanie grafiki.
Poniższe dwa makra będą odpowiedzialne za wyświetlenie oraz usunięcie pliku graficznego z naszego arkusza. Dodatkowe informacje na temat ich działania zawarte są w komentarzach wewnątrz kodu.

view sourceprint?

01	Sub Pokaz_Fote(Kolumna)

02	Dim Nazwa$, Sciezka$

03	Sciezka = ActiveSheet.Cells(1, Kolumna)

04	Nazwa = Sciezka & "\" & ActiveCell.Value

05

06	'kasujemy wszystkie kształty-

07	'tu wywołujemy osobne makro

08	Kasuje_Wszystkie_Kształty

09

10	'wstawianie pliku graficznego i wyświetlenie go w określonej pozycji

11	'uwaga! nie znamy proporcji grafiki a musimy podać parametry wymiarów

12	ActiveSheet.Shapes.AddPicture Nazwa, True, True, _

13	ActiveCell.Offset(0, 1).Left, _

14	ActiveCell.Offset(0, 1).Top, 1600, 1600

15

16	'dlatego tu następuje dostosowanie wymiaru i proporcji

17	With ActiveSheet.Shapes(1)

18	.LockAspectRatio = msoTrue

19	.ScaleHeight 1, msoTrue, msoScaleFromTopLeft

20	.Width = 200

21

End With

22

23

End Sub

view sourceprint?

1	Sub Kasuje_Wszystkie_Kształty()

2	Dim SHP As Shape

3	For Each SHP In ActiveSheet.Shapes

4	SHP.Delete

5

Next 'SHP

6

End Sub

Krok 3. Automatyczne działanie z pomocą obsługi zdarzenia.
Na koniec połączymy nasze makra ze zdarzeniem. Chcemy bowiem aby wyświetlił się nam obraz tylko wtedy, gdy zaznaczymy pojedynczą komórkę w kolumnie zawierającej nazwę pliku, a w każdym z pozostałych przypadków chcemy usunąć zbędną grafikę. W tym celu w module naszego arkusza dodamy następujący kod obsługi zdarzenia Worksheet_SelectionChange:

view sourceprint?

01	Private Sub Worksheet_SelectionChange(ByVal Target As Range)

02	On Error GoTo ErrorHandler

03

04	'gdy wybrano potencjalną pozycję z listy plików graficznych

05	If Target.Row > 10 And Target.Cells.Count = 1 And _

06	UCase(Right(Target.Value, 3)) = "JPG" Then

07	'wywoływne jest makro wyświetlające kolejne wybierane pliki

08	Call Wstawianie_Zdjec.Pokaz_Fote(Target.Column)

09

10

Else

11	Kasuje_Wszystkie_Kształty

12

End If

13

Exit Sub

14	ErrorHandler:

15	Debug.Print "Błąd obsługi zdarzenia o godzinie: " & Time

16

End Sub

Nawiasy mają znaczenie!- procedura parametryzowana

Myślę, że wielu programistów nie zdaje sobie sprawy z faktu, że wywołując zewnętrzną procedurę parametryzowaną Sub ma znaczenie to, czy parametry zostaną podane w nawiasie czy też nie. Chodzi o różnicę, którą obrazują następujące składnie wywołania:

view sourceprint?

1	ProceduraParametryzowana Argument

2	ProceduraParametryzowana (Argument)

Zanim wyjaśnię  różnicę i przyczynę różnicy najlepiej będzie jeżeli spojrzymy na przykład:

view sourceprint?

01

Sub Foo()

02

03	Dim STR As String

04

05	STR = "Hello"

06

07	Boo (STR)  'wywołanie 1

08	Debug.Print STR '>> Hello

09

10	Boo STR   'wywołanie 2

11	Debug.Print STR '>> Hello World

12

13

End Sub

view sourceprint?

1	Sub Boo(ByRef PARAM As String)

2

3	PARAM = PARAM + " World"

4

5

End Sub

Wywołanie procedury Foo sprawi, że najpierw otrzymamy w wyniku 'Hello', a następnie uzyskamy wartość zmiennej 'Hello World". Skąd ta różnica? Otóż ujęcie argumentów procedury w nawias (wywołanie 1 powyżej) zmienia typ parametru z ByRef na ByVal, to zaś sprawia, że zmienna przekazana do podprocedury `Boo` nie zmienia swojej wartości. Przekazanie argumentu bez nawiasu sprawia, że parametr jest typu ByRef a więc wszystkie operacje na nim wykonane w podprocedurze zostaną również przekazane do procedury nadrzędnej.

Podobną różnicę w zachowaniu i wyniku wywołania podprocedury znajdziemy korzystając z instrukcji Call. W tym przypadku dodatkowy nawias będzie zmieniał tryb przekazania parametru. Obrazują to następujące przykłady:

view sourceprint?

1	Call Boo(STR)   >> przekazanie ByRef >>Wynik Hello World

2	Call Boo((STR)) >> przekazanie ByVal >>Wynik Hello

MS Word- podmiana akcji przycisku na wstążce

Aplikacja MS Word udostępnia ciekawą i praktyczną opcję, która umożliwia zamianę standardowej akcji wywołanej dowolnym przyciskiem znajdującym się na wstążce na akcję własną użytkownika. Proces zamiany jest relatywnie łatwy do wykonania i zaprogramowania choć od razu muszę zaznaczyć rzecz ważną- podmiana ta dotyczyć będzie wskazanego szablonu lub dokumentu. Nie zmienia ona akcji danego przycisku dla wszystkich dokumentów. Tak czy inaczej rozwiązanie to znajduje szereg praktycznych i przydatnych zastosowań. Żałuję też jednocześnie, że podobnych rozwiązań nie da się zrealizować we wszystkich aplikacjach MS Office.

Aby osiągnąć cel opisany w powyższym wprowadzeniu musimy wykonać kilka kroków i operacji. Całość zaprezentuję na bazie aktualizacji działania przycisku Wersja Robocza w zakładce Widok aplikacji MS Word 2010 (przycisk zaznaczony na poniższym zrzucie ekranu).

Krok 1. Otwieramy dokument, w którym chcemy zapisać zindywidualizowane zachowanie przycisku.

Krok 2. Przechodzimy do zakładki i wywołujemy polecenie: Widok >> Makra >> Wyświetl makra.

Krok 3. W wyświetlonym oknie Makra, w jego środkowej części z listy rozwijalnej Makra w: wybieramy opcję: Polecenia programu Word.

Krok 4. Chyba najtrudniejszy z etapów- na otrzymanej liście makr musimy odnaleźć i zaznaczyć to makro, które (wydaje się nam) powiązane jest z danym przyciskiem. Czym się kierować w poszukiwaniach- intuicją i logiką opartą o nazwy zakładek, nazwę grupy poleceń czy wreszcie nazwę naszego przycisku, który modyfikujemy.

W naszym przykładzie od razu trafimy na pewną trudność- otóż przycisk Wersja robocza nie będzie reprezentowany przez makro ViewDraft  lecz makro ViewNormal. Aby się przekonać czy dokonaliśmy właściwego wyboru możliwe, że będziemy musieli wykonać i powtórzyć kilka kolejnych kroków.

Proszę pamiętać, aby zaznaczyć wybrane makro i nie zmieniać tego zaznaczenia!

Krok 5. W naszym oknie Makra na liście Makra w: dokonujemy ponownej zmiany- tym razem wskazujemy tam plik Worda, z którym chcemy powiązać indywidualne ustawienia przycisku.

Wskazówka! jeżeli w tym kroku zamiast pliku wskażemy odpowiedni  szablon, np. Normal.Dotm, to nasza zmiana obsługi przycisku powiązana zostanie z tym szablonem a w konsekwencji ze wszystkimi dokumentami, które na bazie szablonu powstaną.

Krok 6. Klikamy w przycisk Utwórz w wyniku czego zostaniemy przeniesieni do edytora VBA w obszar utworzonego makra (proszę zwrócić uwagę na lokalizację kodu- znajduje się on w module w naszym dokumencie). W tym konkretnym przypadku makro powinno mieć następującą postać:

view sourceprint?

01	Sub ViewNormal()

02

'

03	' ViewNormal Makro

04	' Zmienia widok edycji na normalny

05

'

06	If ActiveWindow.View.SplitSpecial = wdPaneNone Then

07	ActiveWindow.ActivePane.View.Type = wdNormalView

08

Else

09	ActiveWindow.View.Type = wdNormalView

10

11

End If

12

13

End Sub

Krok 7. W tym momencie każda modyfikacja, która zostanie dokonana w otrzymanym makrze zostanie jednocześnie powiązana z przyciskiem 'Wersja robocza'. Przekonajmy się o tym dodając do naszego kodu proste polecenie:

view sourceprint?

1	MsgBox "Dokonano zmiany działania przycisku"

A następnie proszę przejść do aplikacji MS Word i wcisnąć przycisk, którego kod poddaliśmy modyfikacji.

Krok 8. Proszę pamiętać o zapisaniu naszego pliku w wariancie z obsługą makr, a więc rozszerzeniem DOCM.

Zapisanie zakresu komórek arkusza w postaci pliku JPG

Niniejsze rozwiązanie znane jest wielu praktykom VBA, szczególnie tym osobom, które wysyłają  fragmenty arkusza w postaci grafiki wstawionej w wiadomości e-mail.

Jak wyglądać będzie makro, którego zadaniem będzie zapisanie utworzenie pliku graficznego JPG prezentującego fragment obszaru arkusza? Pełne rozwiązanie poniżej. W tym wypadku wszystkie dodatkowe komentarze zostały umieszczone poniżej.

view sourceprint?

01	Sub SaveRangeAsJPG()

02

03	Dim SHT As Worksheet

04	Dim RNG As Range

05

06	Application.ScreenUpdating = False

07

08	'określamy arkusz z naszym obszare

09	Set SHT = Sheets("Arkusz1")

10

11	'określamy zakres, który będziemy eksportować...

12	Set RNG = SHT.Range("A1:D5")

13	'... kopiujemy ten obszar

14	RNG.CopyPicture Appearance:=xlScreen, Format:=xlPicture

15

16	'cały trick kryje się w następujących krokach:

17	'1. tworzymy wykres- proszę zwrócić uwagę na _

18	szerokość i wysokość wykresu- taki zapis pozawala _

19	zachować proporcje naszego obszaru

20	With SHT.ChartObjects.Add(Left:=100, Top:=100, _

21	Width:=RNG.Width, Height:=RNG.Height)

22	With .Chart

23	'wklejamy w wykres nasze komórki

24

.Paste

25

26	'wykorzystujemy metodę export wykresu

27	.Export ThisWorkbook.Path & "\TabelaExport.jpg"

28

End With

29

30	'dla porządku usuwamy wykres- nie jest nam już potrzebny

31

.Delete

32

33

End With

34

35

End Sub

I jeszcze dwa obrazy graficzne na koniec- zrzut ekranu z naszą tabelą, która została poddana procesowi exportu oraz plik, który powstał w wyniku działania powyższego makra.

Testowanie zgodności ciągów tekstowych- wyrażenia regularne RegExp- 4/4

W ostatnim wpisie dot. wyrażeń regularnych RegExp chciałbym zwrócić uwagę metodę .Execute, którą wykorzystałem poprzednio w celu odnalezienia i pobrania adresu e-mail z podanego ciągu tekstowego.

Metoda .Execute zwraca kolekcję Matches Collection, która zawiera wszystkie wystąpienia ciągów tekstowych spełniających określone kryteria.  W tej sytuacji w relatywnie łatwy sposób możemy pobrać elementy odpowiadające naszemu wzorcowi.

Prześledźmy to na jednym tylko przykładzie, którego zadaniem będzie pobranie wszystkich adresów e-mail z podanego ciągu tekstowego. W zakresie dalszego zrozumienia zastosowania kolekcji Matches odsyłam do komentarzy w poniższym kodzie.

view sourceprint?

01	Sub RegExp_pobranie_wybranych()

02

03	'proszę pamiętać o referencji do biblioteki RegExp

04	Dim objRE As New RegExp

05	Dim Tekst As String

06	Dim Wynik As Variant

07

08	'nasz przeszukiwany tekst- zawiera 3 e-maile w różnych zapisach

09	Tekst = "Tekst zawiera e-maile adres.email@domena.com.pl w treści. " & _

10	"E-maile jan.kowalski@domena.pl są na różnych pozycjach. " & _

11	"regexp_cool@domena.com oraz posiadają różną konstrukcję."

12

13	With objRE

14	.Global = True

15	.Pattern = _

16	"([A-Za-z0-9_\.-]+)@([A-Za-z0-9_\.-]+[A-Za-z0-9_][A-Za-z0-9_])"

17	If .test(Tekst) Then

18	'Ważne! nasz wynik jest obiektem typu Match,

19	'wymaga użycia instrukcji Set!

20	Set Wynik = .Execute(Tekst)

21

End If

22

End With

23

24	'zwracamy wynik- wszystkie pobrane e-maile

25	Dim EMail As Match

26	For Each EMail In Wynik

27	Debug.Print EMail.Value

28

Next

29	'inny sposób na zwrócenie odnalezionych e-maili

30	Debug.Print Wynik(0).Value

31	Debug.Print Wynik(1).Value

32	Debug.Print Wynik(2).Value

33

34	'dodatkowo możemy pobrać także inne parametry

35	'odnalezionych fragmentów tekstu

36

37	For Each EMail In Wynik

38	'adres e-mail, pozycja w tekście, długość tekstu e-maila

39	Debug.Print EMail.Value, EMail.FirstIndex, EMail.Length

40

Next

41

End Sub