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