VBA kode

Hej
Prøv og læg denne kode i VBA under Denne_projektmappe

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
    Dim sBrugerNavn As String
    sBrugerNavn = Application.UserName
    Dim sDato As Date
    sDato = Date & "  " & Time
   
    Range("A1").Select
    ActiveCell.Value = sBrugerNavn & ",  " & sDato
End Sub

Den virker som den skal, men koden skal kun virke på en bestemt ark f.eks. Ark1(skal kunne ændres. Kan koden ikke gemmes under arket?

Det med at det kun skal virke på f.eks. ark1 har jeg ikke lige en løsning på, måske andre har en.

Du kan lægge en betingelse ind - så denne kode kun køres hvis brugeren står i fx "Ark1"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
If ActiveSheet.Name = "Ark1" Then
   
    Dim sBrugerNavn As String
    sBrugerNavn = Application.UserName
    Dim sDato As Date
    sDato = Date & "  " & Time
   
    Range("A1").Select
    ActiveCell.Value = sBrugerNavn & ",  " & sDato

End If

End Sub

Hej KurtOA & svla, 1000 tak for Jeres hjælp, hvis svla smider et svar her, så opretter jeg en ny tråd med point til KurtOA.

Hej Boro23
Jeg lægger ikke et svar, jeg har ikke nogen løsning hvis det kun drejer sig om f.eks. ark1, jeg har lige testet KurtOA's forslag og synes ikke det virker.
Hans forslag virker ikke hvis man retter i Ark1 og herefter går til et andet ark og lukker herfra, så bliver celle A1 ikke ajourført.
Ajourføring i celle A1 foretages kun hvis der lukkes fra ark1 efter at ark1 er rettet.

Det kan Boro23 have ret i ;-(
Overvejer om jeg kan finde en løsning der tager højde for dette.

mvh Kurt

Hej svla, du har ret, den perfekte kode ville være, hvis A1 i ark1 blev opdateret uanset hvor i filen der blev lavet en ændring og gemt. Havde overset denne detalje. Tak for det.

Hej KurtOA, håber du kan finde en løsning.

Lader lige tråden stå nogle dage endnu, kan jo være der er andre der har en løsning.

Har fundet en kode i en anden tråd som virker, men bruger navn skal tilføjes, nogen der kan hjælpe?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Worksheets(1).Range("A1") = "Senest gemt: " & Format(Now, "dd/mm/yy hh:mm:ss")
End Sub

Måske denne :


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("A1") = "Senest gemt af: " & (Environ("UserName")) & "  d. " & Format(Now, "dd/mm/yy hh:mm:ss")
End Sub

mvh

Sådan, tak for hjælpen, har dog ændres arkets navn, så arket kan placeres hvorsom helst i filen.

Jeg lukker tråden, da svla ikke vil have point.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets("Liste").Range("A1") = "Senest gemt af: " & (Environ("UserName")) & "  d. " & Format(Now, "dd/mm/yy hh:mm:ss")
End Sub

God arbejdslyst ;-)

mvh Kurt