Új hozzászólás Aktív témák

• Fferi50 Topikgazda

  2022-02-18 10:21:23 #48548

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  Fferi50

  Topikgazda

  válasz lappy üzenetére #48546

  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 tenni
Dim cl As Range,szemely As String
szemely = Application.UserName
Select Case szemely
       Case "Név1" 'a belépő windows neve
            szemely = "jóska"  ' a belépő táblázat beli neve
       Case "Név2"
            szemely = "pista"
       '...felsorolod a további név lehetőségeket
End 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ása
Set cl = Sheets("Munka1").Rows(6).Find(what:=szemely, LookIn:=xlValues, lookat:=xlWhole)
If cl Is Nothing Then
   MsgBox szemely & " nem szerepel a felhasználók között!", vbCritical
   Exit Sub
Else
   If cl.Offset(-4, 0).Value < 0.7 Then
      MsgBox szemely & " még csak " & cl.Offset(-4, 0).Text & " szabadságot használtál fel!"
   End If
End If
End 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