- Magga: PLEX: multimédia az egész lakásban
- Luck Dragon: Asszociációs játék. :)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- btz: Internet fejlesztés országosan!
- Mr Dini: Mindent a StreamSharkról!
- M0ng00se: Hardvert áruhitelre?
- bambano: Bambanő háza tája
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
-
LOGOUT
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Mutt
senior tag
Szia,
Szerintem itt fontos tisztázni azt, hogy amit a Personal.xlsb "Workbook_Open" eseményébe teszel, akkor az csak egyszer fog lefutni, amikor az Excel indulásakor az egyéni makrófüzet a háttérben megnyílik.
Azt akarod, hogy minden Excel fájl megnyitásakor legyen vmi ellenőrzés és azt ahogy tetted egy Class Module-al lehet megtenni.
Próbáld ki:
1. Personal.xlsb-ben legyen egy class module, a neve fontos clsApp legyen (ha más akkor a másik modulban kell módosítani). A tartalma pedig ez:Public WithEvents AppEvents As Application
Private Sub AppEvents_WorkbookOpen(ByVal wb As Excel.Workbook)
Call OpenEvent(wb)
End Sub
Private Sub AppEvents_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
Call BeforeClose(wb, Cancel)
End Sub
Ahogy látható két workbook eventhez (open és a beforeclose) rendeljük a saját kódunkat.
2. A Personal.xlsb-ben legyen egy normál modul amibe az alábbi kódok kellenek:
Dim AppObject As New clsApp
Sub Init()
'ezt az egyéni makrófüzet Open eseményében fogjuk meghívni
Set AppObject.AppEvents = Application
End Sub
Sub OpenEvent(wb As Workbook)
'ez az egyéni Workbook_Open eseményünk ahova tesszük a saját kódot
'a megnyitott fájl ellenőrzése (a példában ha M-el kezdődik a neve)
If wb.Name Like "M*" Then
'hozzáadjuk a kedvenc makrónkat az eszköztárhoz
Call AddNewMenuItem
End If
End Sub
3. A Personal.xlsb ThisWorkbook eseményeibe pedig tegyük ezt be:
Private Sub Workbook_Open()
Call Init
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteControls(True)
End Sub
Vagyis amikor elindítjuk az Excel-t, akkor az "Init" kódban megadott sor lefut, ami annyit tesz, hogy egy objektumot hoz létre ami tartalmazza az Excelben megnyitott fájlokat.
A másik pedig ha bezártuk az Excel-t teljesen, akkor előtte töröljük a saját menűt.4. Az egyéni parancs eszköztárra (QAT) kihelyezése.
Gyorselérési eszköztárra nem raktam még kóddal ki gombot, de a https://jkp-ads.com/rdb/win/s2/win004.htm oldalon találtam egy hasznos add-int, aminek a kódja szerint ez könnyen megy, de nekem nem jött össze. Az addin ettől még szuper, ha van sok saját makród, akkor ezzel tudod rendszerezni és elérni QAT-ról.Ami ment az egy új menű az eszköztáron. Én régen ezt használtam, MS365-ben most is megy.
Szóval van a normál modulban még 2 program, ami felteszi illetve leveszi a saját makródat.
Ami felteszi az így néz ki:
Private Sub AddNewMenuItem()
'töröljük az esetleg létező saját menűt
DeleteControls
Dim CmdBar As CommandBar
Dim CmdBarMenuItem As CommandBarControl
Set CmdBar = Application.CommandBars("Worksheet Menu Bar")
'Add a new menu item
Set CmdBarMenuItem = CmdBar.Controls(CmdBar.Controls.Count - 1).Controls.Add
'Set the properties for the new control
With CmdBarMenuItem
.Caption = "Saját Makró1"
.OnAction = "'" & ThisWorkbook.Name & "'!Kedvencem"
.Tag = C_TAG
End With
End Sub
Ehhez van egy C_TAG állandó a modul elején definiálva:
Private Const C_TAG = "Makrocska" 'C_TAG legyen egyedi név
Illetve fent a kódban az OnAction végén van a makró neve (esetemben "Kedvencem"),
ami ennyit tartalmaz csak:Sub Kedvencem()
MsgBox "Palacsinta", vbOKOnly
End Sub
Ami leveszi az pedig ez:
Sub DeleteControls(Optional tuti As Boolean = False)
Dim Ctrl As CommandBarControl
On Error Resume Next
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Do Until Ctrl Is Nothing
Ctrl.Delete
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Loop
End Sub
A fenti kódokkal el tudtam érni, amit szerettél volna:
1. Akár jelszavas fájlok esetén is (csak a megfelelő jelszó ismeretében) fut le az open esemény...
2. ami a kritériumoknak megfelelően (a példámban csak az nézem hogy a fájl neve M-el kezdődik-e vagy sem) kirak egy makrót az eszköztárra...
3. az Excel bezárásakor pedig leveszi a dolgokat.Próbáld ki, ha még kell.
A kódok alapja a Walkenbach VBA könyve (17-es fejezet). Régi (az újabbak sem hinném hogy rosszabbak), de még mindig nagyon jó. Én csak ajánlani tudom angolul tudóknak.Két fontos dolog:
1) Saját makrók esetén fontos tudni jól használni a Thisworkbook és Activeworkbook-ot.
2) Én inkább fixen kiraknám a makrót a QAT-ra és a makrót készíteném fel arra, hogy ha a fájl nem felel meg a feltételeknek akkor ne csináljon vele semmit.üdv
-
Pá
addikt
Lehet, hogy kicsit kuszán írtam mit szeretnék.
Szóval a lényeg és, ami fontos, hogy a Personal.xlsb-m ThisWorkbook részébe tennék egy Workbook_Open subot, aminek az lenne a célja, hogy bizonyos szempontból automatikusan megvizsgáljon mindegy egyes excel-t, amit megnyitok.
Az a problémám, hogy az excelek egy része jelszóval védett, amiket megnyitok. És úgy kéne ezt a subot beállítani, hogy a jelszóval védett exceleknél várja meg, amíg megadom a jelszót, mielőtt lefut.
Igazából nem tudom, hogy excelben van-e bármi jele, hogy megkapta a jelszót a file és ehhez tudnám kötni a macro futását.
MsgBox-szal tesztelgettem a workbook open-t de jellemzően már azelőtt elkezdte dobálni a MsgBoxot, mielőtt egyáltalán feljött a jelszó kérő ablak, szóval valahogy késleltetni kéne a macrot addig.
Új hozzászólás Aktív témák
Hirdetés
- Windows 10
- Továbbfejlődött a Keychron egéralternatívája a Logitech MX Masterre
- One mobilszolgáltatások
- Fotók, videók mobillal
- Google Pixel 9a - a lapos munka
- Tudományos Pandémia Klub
- Media Player Classic és Home Cinema (MPC-HC)
- Samsung LCD és LED TV-k
- Házimozi belépő szinten
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- További aktív témák...
- Xbox Game Pass Ultimate kedvező áron, egyenesen a Microsoft-tól! - AUTOMATA BOLT
- BESZÁMÍTÁS! MSI B450M R7 2700X 32GB DDR4 512GB SSD RTX 3050 8GB Rampage SHIVA Thermaltake 500W
- Bomba ár! HP EliteBook 8460P - i5-2GEN I 4GB I 320GB I DVD I 14" HD I W10 I Garancia!
- LG UltraGear Gaming Monitorok: FRISS SZÁLLÍTMÁNY -30%
- Samsung Galaxy S21 Ultra , 12GB , 128 GB , Kártyafüggetlen
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest