Automatisch een nieuw werkblad per gebruiker

[ricohard73]

Goedemiddag,

Voor het registreren van het gebruik maak ik gebruik van onderstaande code.
Is het ook mogelijk om per gebruiker een eigen werkblad toe te wijzen ipv alleen blad3?

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
rij = Sheets("Blad3").Range("A1000").End(xlUp).Row + 1
Sheets("Blad3").Range("A" & rij) = Date
Sheets("Blad3").Range("B" & rij) = Time
Sheets("Blad3").Range("C" & rij) = Application.UserName
Sheets("Blad3").Range("D" & rij) = ThisWorkbook.Name
Application.SaveWorkspace
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
rij = Sheets("Blad3").Range("B1000").End(xlUp).Row + 1
Sheets("Blad3").Range("E" & rij) = Date
Sheets("Blad3").Range("F" & rij) = Time
Sheets("Blad3").Range("G" & rij) = Application.UserName
Sheets("Blad3").Range("H" & rij) = ThisWorkbook.Name
End Sub

 

[Wigi]

Zoiets

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Dim rij As Long
    
    Application.DisplayAlerts = False
    
    With Sheets(Application.UserName)
    
        rij = .Range("A1000").End(xlUp).Row + 1
        .Range("A" & rij).Resize(1, 4).Value = Array(Date, Time, Application.UserName, ThisWorkbook.Name)
    
    End With
    
    Application.SaveWorkspace
    Application.DisplayAlerts = True
    
End Sub

Wigi

 

[ricohard73]

nee niet echt wigi.
Onderstaande programmering heb ik er van gemaakt. Maar bij With Sheets(Application.UserName) loopt hij al vast

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Dim rij As Long
 Application.DisplayAlerts = False 
With Sheets(Application.UserName)
 rij = .Range("A1000").End(xlUp).Row + 1 .Range("A" & rij).Resize(1, 4).Value = Array(Date, Time, Application.UserName, ThisWorkbook.Name) 
End With 
Application.SaveWorkspace 
Application.DisplayAlerts = True 
End Sub

Private Sub Workbook_Open()
With Sheets(Application.UserName)
 rij = .Range("A1000").End(xlUp).Row + 1 .Range("A" & rij).Resize(1, 4).Value = Array(Date, Time, Application.UserName, ThisWorkbook.Name) 
End With 
Application.SaveWorkspace 
Application.DisplayAlerts = True 
End Sub

 

[Wigi]

nee niet echt wigi.
Hij blijft hangen bij

With Sheets(Application.UserName)

Uiteraard, dat blad bestaat niet.

Ofwel maak je dat zelf eerst aan (1 per gebruiker), ofwel schrijf je code die dat aanmaakt als het nog niet bestaat. Volg de 3 topics van Kibus die op dit moment "bezig zijn".

Wigi

 

[ricohard73]

Het zal aan mij liggen , maar hij blijft vastlopen.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rij As Long
 Application.DisplayAlerts = False
[COLOR="Red"]With Sheets(Application.UserName)[/COLOR]
rij = .Range("A1000").End(xlUp).Row + 1
.Range("A" & rij).Resize(1, 4).Value = Array(Date, Time, Application.UserName, ThisWorkbook.Name)
End With
Application.SaveWorkspace
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
With Sheets(Application.UserName)
 rij = .Range("A1000").End(xlUp).Row + 1
 .Range("A" & rij).Resize(1, 4).Value = Array(Date, Time, Application.UserName, ThisWorkbook.Name)
End With
Application.SaveWorkspace
Application.DisplayAlerts = True
End Sub

Sub BladAanmakenWigi()
Dim ws As Worksheet
Dim sSheetName As String
sSheetName = " Application.UserName " & ActiveSheet.Name
Set ws = ThisWorkbook.Sheets.Add(after:=ActiveSheet)
End Sub

 

[ricohard73]

Kan iemand mij helpen. please.....
Ik begrijp niet waarom hij vast blijft lopen....... Zie bovenstaande......

 

[Wigi]

Is ondertussen opgelost: http://www.helpmij.nl/forum/showthread.php?t=341011

 

[huijb]

Kan iemand mij helpen. please.....
Ik begrijp niet waarom hij vast blijft lopen....... Zie bovenstaande......

Je maakt er een behoorlijk puinhoop van hier. Je houd je niet aan de regels die hier gelden en al helemaal niet aan de regels die gelden op dit fotum. Voor het eerste kan ik je naar hier verwijzen. En voor het tweede naar de algemene regels van dit forum. Ergo, VBA code plaats je tussen de codetags. En twee keer een vraag plaatsen is niet toegestaan.