Beste forumleden,
Via de zoekfunctie heb ik 2 mooie werkbladen (Users login en tijdsregistratie) gevonden die ik graag wil laten samenwerken.
Onder Logboek-Time wordt de login periode bijgehouden in een tabel, telkens wanneer er iemand inlogt en of het werkblad sluit.
Nu is alleen zichtbaar, “admin” geopend/gesloten, dit werkt goed.
Probleem: Graag zou ik hebben dat de login naam (KVD, enz.) voorkomt in de tabel bij geopend.
De lijst met de login namen staat in tabblad Hide this sheet kolom A.
Op tabblad Logboek-Time staat rechts van de tabel een juist voorbeeld van hoe het zou moeten zijn.
Onder sub validatiePW zie ik geen link naar de lijst met login namen zodat via ToevoegenActie de laatst ingelogde naam voorkomt in de tabel als, voorbeeld “KVD geopend”
Ik weet dat het not done is een bijlage met paswoord te leveren, maar om het werkende te laten zien is het denk ik nodig. Login: KVD en paswoord: 1234.
Met het testen van de bijlage, Test_fd.xlsm merk ik op dat je dit bestand eerst moet opslaan en terug starten om de volledige werking te zien anders krijg je fouten.
Kan dit aangepast worden dat de login naam vermeld wordt op de tabel bij geopend?
Alvast bedankt.
Mvg.
Marc
Via de zoekfunctie heb ik 2 mooie werkbladen (Users login en tijdsregistratie) gevonden die ik graag wil laten samenwerken.
Onder Logboek-Time wordt de login periode bijgehouden in een tabel, telkens wanneer er iemand inlogt en of het werkblad sluit.
Nu is alleen zichtbaar, “admin” geopend/gesloten, dit werkt goed.
Probleem: Graag zou ik hebben dat de login naam (KVD, enz.) voorkomt in de tabel bij geopend.
De lijst met de login namen staat in tabblad Hide this sheet kolom A.
Op tabblad Logboek-Time staat rechts van de tabel een juist voorbeeld van hoe het zou moeten zijn.
Code:
Sub ToevoegenActie(bOpen As Boolean)
With Sheets("Logboek-Time").ListObjects("TBL_Logboek")
Sheets("Logboek-Time").Unprotect Password:="1234"
.ListRows.Add.Range.Resize(, 3).Value = Array(Now, Application.UserName, IIf(bOpen, "Geopend", "Gesloten"))
Sheets("Logboek-Time").Protect Password:="1234"
End With
End Sub
Code:
Option Explicit
Dim ws As Worksheet
Dim cl As Range
Dim rng As Range
Dim bOK As Boolean
Dim lRw As Long
Dim iCounta As Integer
Dim iLevel As Integer
Dim sPW As String
Dim sUser As String
Dim sMsg As String
Const sTitle As String = "Incorrect Password"
Const sStyle As String = vbOKOnly + vbExclamation
Const FullHeight As Long = 230
Const InitialHeight As Long = 150
Sub validatePW()
' On Error GoTo err_handler
If Me.cboUser.Value = "Manager" And Me.tbxPW = Sheet1.Cells(2, 1).Value Then
Me.cmdManage.Visible = True
Exit Sub
End If
'*******************************************************************************************************************
'toestemming = Application.WorksheetFunction.VLookup(iMens, Sheets("Hide this sheet").Range("A:B"), 2, False)
'Application.UserName = iMens
'Dit is een voorbeeld dat ik gevonden heb, maar niet gebruikt kan worden.
'*******************************************************************************************************************
Select Case iCounta
Case 1, 2, 3, 4
With Sheet1
Set rng = .Range(.Cells(6, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set cl = rng.Find(sUser, LookIn:=xlValues)
Call ToevoegenActie(True) 'dit voegt nu al bij het sluiten van het werkboek in tab Logboek-Time "gesloten Admin toe"
End With
If cl.Offset(0, 1).Value <> Me.tbxPW.Text Then
sMsg = "You have entered an incorrect Password" _
& vbNewLine & "Try again" & vbNewLine & _
"You have " & iCounta & " goes left"
MsgBox sMsg, sStyle, sTitle
With Me
.cboUser.Value = vbNullString
.tbxPW = vbNullString
.cboUser.SetFocus
Exit Sub
End With
ElseIf cl.Offset(0, 1).Value = Me.tbxPW.Text Then
iLevel = cl.Offset(0, 2).Value
MsgBox "Correct Information Entered. Please Proceed.", vbOKOnly + _
vbInformation, "Correct Information entered."
Me.cmdNew.Visible = True
bOK = True
Select Case iLevel
Case 1
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Dept1"
ws.Visible = xlSheetVisible
Case Else
On Error Resume Next
ws.Visible = xlSheetVeryHidden
On Error GoTo 0
End Select
Next
Case 2
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Dept2", "Dept3"
ws.Visible = xlSheetVisible
Case Else
On Error Resume Next
ws.Visible = xlSheetVeryHidden
On Error GoTo 0
End Select
Next
Case 3
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "JAN", "FEB", "MRT", "APR", "MEI", "JUN", "JUL", "AUG", "SEP", "OKT", "NOV", "DEC", "Logboek-Time", "Hide this sheet"
ws.Visible = xlSheetVisible
Case Else
On Error Resume Next
ws.Visible = xlSheetVeryHidden
On Error GoTo 0
End Select
Next
Case 4
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "JAN", "FEB", "MRT", "APR"
ws.Visible = xlSheetVisible
Case Else
On Error Resume Next
ws.Visible = xlSheetVeryHidden
On Error GoTo 0
End Select
Next
End Select
'Unload Me 'nodig als je gedeelte password aanpassen niet wil zien
End If
Sheets("Splash").Visible = xlVeryHidden
Case 0
MsgBox "You have tried three time incorrectly. WorkBook will now close" _
, vbOKOnly + vbExclamation, "Warning"
bOK = True
'Unload Me
err_handler:
'this line should be used in the final version
Application.Quit
ActiveWorkbook.Close SaveChanges:=False 'close without saving
End Select
End SubMet het testen van de bijlage, Test_fd.xlsm merk ik op dat je dit bestand eerst moet opslaan en terug starten om de volledige werking te zien anders krijg je fouten.
Kan dit aangepast worden dat de login naam vermeld wordt op de tabel bij geopend?
Alvast bedankt.
Mvg.
Marc
