Hirdetés
-
PROHARDVER!
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
-
Fferi50
Topikgazda
Szia!
Gondolom, hogy akivel nincs baj, annak nem szeretnél üzenetet adni. Ezért érdekes a belépés módja.
Az Application.UserName visszaadja, hogy éppen ki az aktuális felhasználó. Miután ez egy megosztott fájl, ezért ez a felhasználó név a Windows név lesz. Ezeket a neveket kellene párosítani a felhasználók munkalapon használt neveihez. Így már lehet keresni a hozzá tartozó információkat.
A minta makró, amit a Thisworkbook kódlapjára kell bemásolni:Private Sub Workbook_Open()If Date < DateSerial(Year(Date), 8, 1) Then Exit Sub ' ha aug. 1 előtt vagyunk nem kell semmit tenniDim cl As Range,szemely As Stringszemely = Application.UserNameSelect Case szemelyCase "Név1" 'a belépő windows neveszemely = "jóska" ' a belépő táblázat beli neveCase "Név2"szemely = "pista"'...felsorolod a további név lehetőségeketEnd Select'vagy' a belépők windows és táblázatbeli neve a hivatkozott tartományban van, elől a windows név' pontos legyen mindkét név beírása a tartományba'szemely = Application.VLookup(szemely, Sheets("Munka1").Range("A2:B20"), 2, 0)'eddig tart a belépő azonosításaSet cl = Sheets("Munka1").Rows(6).Find(what:=szemely, LookIn:=xlValues, lookat:=xlWhole)If cl Is Nothing ThenMsgBox szemely & " nem szerepel a felhasználók között!", vbCriticalExit SubElseIf cl.Offset(-4, 0).Value < 0.7 ThenMsgBox szemely & " még csak " & cl.Offset(-4, 0).Text & " szabadságot használtál fel!"End IfEnd IfEnd Sub
A próbához az első sort (If Date) kommenteld ki, így látni fogod hogyan működik. A dátumot átírhatod tetszésed szerint.
Én jobbnak látom a második megoldást, amikor a felhasználó nevek párosítása táblázatban van és Vlookup-pal keressük meg. Így a felhasználók változását csak a munkalapon kell átírni.
Remélem erre gondoltál.
Üdv.
Új hozzászólás Aktív témák
- BESZÁMÍTÁS! HP Elitebook 745 G6 14 üzleti notebook - R5 3500U 16GB DDR4 256GB SSD Vega 8 IGP WIN11
- CSÍKOS! MacBook Pro 16" M1 Pro 16GB 512GB Gar.
- Telefon felvásárlás!! iPhone 13 Mini/iPhone 13/iPhone 13 Pro/iPhone 13 Pro Max
- GYÖNYÖRŰ iPhone 13 128GB Red-1 ÉV GARANCIA - Kártyafüggetlen, MS4373, 100% Akkumulátor
- Xbox Elite Series 2 Core kontroller
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50

