Mai névnap

Mindenekelőtt BÚÉK mindenkinek! Remélem a tavalyi év utolsó napja mindenkinek az elképzelése szerint alakult. Én most itthon töltöttem a szilvesztert, az emeletről fantasztikus kilátás volt vagy egy tucat tűzijátékra egy időben. Persze a szokásos lencse-virsli-pezsgő kombináció nem maradt el.

A 2019-es esztendő első posztjának egy könnyedebb témát találtam ki: az aktuális névnap kiíratását Excelben.

Ha csak a végeredményre vagy kíváncsi, a munkafüzet innen letölthető, viszont a makró csak ebben a fájlban működik (a fájl megnyitásakor vagy futtatáskor). Ha bárhonnan szeretnéd a makrót futtatni (vagyis megtudni az aktuális névnapot független attól, hogy melyik munkafüzet van megnyitva), akkor olvass tovább.

Nekem nincs névnapos falinaptáram, az aktuális névnapért pedig nem mindig akarok felmenni egy hírportálra vagy a Facebook-ra. Az alábbi megoldással viszont – akármelyik munkafüzetben vagyunk – egyetlen kattintással ellenőrizhetjük, kit is kellene felköszöntenünk a mai napon. A lépések ne riasszanak el, mintegy 5-10 perc alatt végrehajtható az összes instrukció, az Excelbe épített névnapos kiegészítő viszont örökös 🙂

A legalaposabb listát a Wikipédián találtam itt. Képrészlet az oldalról:

Ezt emeltem át egy munkafüzetbe és alakítottam át így:

Tudom, nem annyira “fancy”, viszont itt a kinézet nem is annyira számít. Az “A” oszlopban dátum formátum lett beállítva.

Kezdjük a kóddal:

Sub NevnapKereso()

Dim Rng As Range, i As Long, Sz As Boolean

'Készítette: XLMotyo (https://xlmotyo.hu)

'Névnap lista forrása:
'https://hu.wikipedia.org/wiki/Magyar_n%C3%A9vnapok_list%C3%A1ja_d%C3%A1tum_szerint

'ha az évet frissíteni kell pl. 2019-rõl 2020-ra: "A" oszlopot kijelölni, majd CTRL+H (Keresés és csere):
'Keresett szöveg: 2019
'Csere erre: 2020
'majd "Az összes cseréje" gombot megnyomni és a kódot újra lefuttatni ha szükséges.

Application.ScreenUpdating = False

Set Rng = ThisWorkbook.Worksheets("Sheet1").UsedRange 'szükség esetén módosítani a munkalap nevét ("Sheet1")
Sz = False

For i = 2 To Rng.Rows.Count
    If CStr(Rng.Cells(i, 1).Value) = Format(Now, "yyyy.mm.dd") Then
        Sz = True
        ActiveWindow.ScrollRow = i
        
        Range(Rng.Cells(i, 1), Rng.Cells(i, 2)).Select 'ha a Personal.xlsb-ben van a kód: ezt a sort megjegyzésbe tenni
        
        MsgBox "Ma" & vbNewLine & vbNewLine & Rng.Cells(i, 2) & vbNewLine & vbNewLine & " névnapja van.", , Rng.Cells(i, 1)
        Exit For
    End If
Next i

If Sz = False Then MsgBox "Nincs névnapi találat a mai dátumhoz!", vbExclamation, Format(Now, "yyyy.mm.dd")

Application.ScreenUpdating = True

End Sub

Sub NevnapKereso()

Dim Rng As Range, i As Long, Sz As Boolean

'Készítette: XLMotyo (https://xlmotyo.hu)

'Névnap lista forrása:

'https://hu.wikipedia.org/wiki/Magyar_n%C3%A9vnapok_list%C3%A1ja_d%C3%A1tum_szerint

'ha az évet frissíteni kell pl. 2019-rõl 2020-ra: "A" oszlopot kijelölni, majd CTRL+H (Keresés és csere):

'Keresett szöveg: 2019

'Csere erre: 2020

'majd "Az összes cseréje" gombot megnyomni és a kódot újra lefuttatni ha szükséges.

Application.ScreenUpdating = False

Set Rng = ThisWorkbook.Worksheets("Sheet1").UsedRange 'szükség esetén módosítani a munkalap nevét ("Sheet1")

Sz = False

For i = 2 To Rng.Rows.Count

If CStr(Rng.Cells(i, 1).Value) = Format(Now, "yyyy.mm.dd") Then

Sz = True

ActiveWindow.ScrollRow = i

Range(Rng.Cells(i, 1), Rng.Cells(i, 2)).Select 'ha a Personal.xlsb-ben van a kód: ezt a sort megjegyzésbe tenni

MsgBox "Ma" & vbNewLine & vbNewLine & Rng.Cells(i, 2) & vbNewLine & vbNewLine & " névnapja van.", , Rng.Cells(i, 1)

Exit For

End If

Next i

If Sz = False Then MsgBox "Nincs névnapi találat a mai dátumhoz!", vbExclamation, Format(Now, "yyyy.mm.dd")

Application.ScreenUpdating = True

End Sub

Ezt a makrót adjuk hozzá az egyéni makró munkafüzethez (Personal.xlsb-hez, azaz Personal Macro Workbook-hoz). Ha nincs ilyen egyéni makró munkafüzet, az alábbi linkemen megnézhetitek, hogyan kell létrehozni (videóval):

https://xlmotyo.hu/blog/egyeni-makro-munkafuzet/

Lépések:

1. Nyissunk meg egy üres Excel munkafüzetet

2. Válasszuk a Nézet (View) menüből a Felfedés (Unhide) opciót:

3. Ha nincs kiválasztva, jelöljük ki a “PERSONAL.XLSB”-t majd “OK” gomb:

A címsorban a munkafüzet neve immáron “PERSONAL.XLSB”:

4. A “PERSONAL.XLSB” munkafüzet “Sheet1” munkalapjára bemásoljuk a névnapi adattartományt (A és B oszlopba) abból a fájlból, amit innen letöltöttünk:

5. ALT+F11-gyel megnyitjuk a VBE-t (Visual Basic szerkesztőjét) és hozzáadunk egy modult. Ehhez az alábbi posztomat ajánlom, videóval:

https://xlmotyo.hu/blog/kod-hozzaadasa-egyeni-makro-munkafuzethez/

Modul hozzáadása: a “Modules” mappán jobb egérgombbal kattintunk, majd “Insert” és “Module”:

6. Ide másoljuk bele a fentebbi kódot. Az eredmény ehhez hasonló lesz:

7. Kattintsunk a Mentés gombra a VBE-ben, majd zárjuk be a VBE ablakot a jobb felső sarokban lévő X-szel (ne az Excel-t zárjuk be!):

Mentés…

… majd bezárás X-szel:

8. A címsorban a “PERSONAL.XLSB”-t kell látnunk. A Nézet (View) menüben válasszuk az Elrejtés (Hide) opciót, így az egyéni makró munkafüzet rejtve lesz, ahogy eddig is:

9. Zárjuk be az egész Excelt a jobb felső sarokban lévő piros X-szel. A felugró ablaknál válasszuk a “Mentés” gombot:

10. Nyissunk meg egy üres Excel munkafüzetet és adjuk hozzá a makrót a Gyorselérési eszköztárhoz (angolul QAT vagyis Quick Access Toolbar). A kapcsolódó bejegyzésem itt látható (videóval):

https://xlmotyo.hu/blog/gyorseleresi-eszkoztar/

Jobb egérgombbal kattintunk a Gyorselérési eszköztár-on és a “Gyorselérési eszköztár testreszabása…” lehetőséget választjuk:

11. A “Választható parancsok helye” opció alatt egy legördülő lista található. Válasszuk ki a “Makrók”-at:

12. Keressük meg a makró nevét (a név itt a “PERSONAL.XLSB!” kifejezés után található “NevnapKereso”), majd kattintsunk a “Felvétel” gombra:

13. A makró neve most a jobb oldali lista alján helyezkedik el. Addig kattintsunk a felfele nyílra, míg a név a kívánt pozícióba kerül:

14. Ezt követően az “OK” gombot nyomjuk meg a jobb alsó sarokban. Én a lista legtetejére raktam a makró nevét.Tehát a kódhoz tartozó parancsikon a legelső a QAT-n:

Készen vagyunk. Ezután csak kattintsunk rá az ikonra (vagy használjuk az ALT+1 billentyűkombinációt) és máris láthatjuk, ma kinek van névnapja:

Mivel a makrót az egyéni makró munkafüzethez (Personal.xlsb-hez) adtuk hozzá, így bármelyik munkafüzet van megnyitva, működik.

Még valami: ha az évet kell frissíteni pl. 2019-ről 2020-ra: az adatokat tartalmazó munkalapon az “A” oszlopot jelöljük ki, majd CTRL+H (Keresés és csere):
Keresett szöveg: 2019
Csere erre: 2020
majd “Az összes cseréje” gombot megnyomni és a munkafüzetet elmenteni:

Továbbfejlesztéshez ötletek:

a makró futtatása után görgessen az aktuális sorhoz – KÉSZ
a main felül a tegnapi és a holnapi névnapot is megjeleníteni
előre megadni bizonyos névnapokat és a makró automatikusan jelzi, ha a mai napon ezek közül valamelyik esedékes

Remélem hasznos volt a poszt.
Kérdésed, észrevételed van? Szólj hozzá lent vagy dobj egy emailt: xlmotyo@gmail.com