Urmăream zilele trecute un podcast al lui Mr. Excel şi spre sfârşitul acestuia a lansat o provocare ce a devenit concurs până la urmă.
Care era cerinţa ?
Folosind un slicer să se schimbe o serie de imagini, dar în acelaşi timp să apară şi câte un text personalizat legat de acele poze, într-o formă (shape).
Mai mult decât atât, în momentul schimbării pozelor, poza anterioară să nu mai fie afişată.
După o serie de încercări, am ajuns la o soluţie destul de simplă.
1. Am creat un folder – Images – şi am stocat 3 poze;
2. Am modificat numele pozelor astfel: My_Beach.jpg, My_Car.jpg şi My_House.jpg;
3. Am creat un workbook şi l-am salvat în formatul macro-enabled *.xlsm – Images in Slicer.xlsm;
4. Într-una dintre sheet-uri am creat un tabel ce conţine trei coloane: ID, Object şi Text;
| ID | Object | Text |
| 1 | My_Beach | This is my beach |
| 2 | My_Car | This is my car |
| 3 | My_House | This is my house |
5. Pe baza acestui tabel, am creat un PivotTable într-un alt sheet;
6. În tabelul pivot am specificat pentru Row Labels, coloana Object;
| Object |
| My_Car |
| My_House |
| My_Beach |
7. Am inserat un slicer şi ca sursă am specificat coloana ID şi apoi am modificat slicer-ul astfel încât valorile să apară sub formă de butoane.
8. În celula D2 vom scrie următoarea formulă: =VLOOKUP(A4;tblObjects[[Object]:[Text]];2)
Utilizând funcţia VLOOKUP vom căuta valoarea ce rămâne după filtrare, în tabelul din primul sheet, şi vom afişa textul din coloana 2.
9. Vom insera un shape şi după ce îl desenăm, executăm un click pe acesta şi în bara de formule scriem expresia: =$D$2
Astfel, rezultatul formulei va fi afişat în shape.
10. Vom ascunde formula din celula D2, prin tragerea acestui shape peste celulă.
11. Acum vom trece la partea de macrocomenzi.
Accesăm editorul VBA folosind combinaţia de taste Alt+F11.
12. În cadrul editorului, vom accesa modulul foii în care avem inserat slicer-ul. În cazul meu este Sheet1 (Slicer).
În partea dreaptă vom selecta opţiunea Worksheet din caseta de evenimente (a) şi opţiunea Change din caseta de proceduri (b).
13. Codul scris este:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err
'create Location as a constant
Set Location = Range("A4")
'set cell J4 as default selected cell
Range("J4").Select
'delete all previous images
ActiveSheet.Pictures.Delete
'insert a new image
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Location & ".jpg").Select
Exit Sub
err:
MsgBox err.Description, vbOKOnly + vbInformation, "Error"
End Sub
Să detaliem codul:
– pentru a nu complica codul, definim o constantă numită Location, constantă ce va face referire la adresa celulei în care am numele pozei.
– am definit celula J4 ca fiind celula activă, în mod implicit, pentru afişarea pozei;
– am adăugat o linie de cod ce va şterge toate pozele existente în sheet;
– folosind calea relativă a workbook-ului, dar şi numele pozelor extrase din celula A4, vom introduce pozele în sheet.
Această porţiune din cod: ThisWorkbook.Path & "" & Location & ".jpg" are ca rezultat C:Documents and SettingsAlexandruDesktopImages.jpg (lipseşte numele pozei, fiindcă această porţiune de cod este testată în Immediate Window).
Acum, iată rezultatul:
P.S. Sunt una dintre cele 5 persoane care au câştigat câte o carte semnată de Mr. Excel.