-
Fototrend
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
-
Delila_1
veterán
válasz
poffsoft
#29372
üzenetére
Poffsoft , Belnir és bsh
Tegnap csak a lényeg maradt ki, a figyelt lapok változásának a követése.

A megfigyelt laphoz kell rendelni a lenti 2 makrót, hogy az ezen történt változásokat is tárolják a Rejtett lapon. A "Rejtett" lap Visible tulajdonságát eleve xlSheetVeryHidden-re lehet állítani, azért a makró tud bele írni.
Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
If Target.Count <> 1 Then Exit Sub
If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Rejtett")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & lastrow)
.Offset(0, 0) = Target.Parent.Name 'A – hol volt változás
.Offset(0, 1).Value = Target.Address 'B – Változás helye
.Offset(0, 2).Value = Now() 'C – időpont
.Offset(0, 3).Value = aktualis 'D – változás előtti adat
.Offset(0, 4).Value = Target.Value 'E – változtatás utáni érték
.Offset(0, 5).Value = Environ$("username") 'F – felhasználó neve
.Offset(0, 6).Value = Environ$("computername") 'G – PC neve
.Offset(0, 7).Value = Environ$("userdomain") 'H – felh. domain
End With
End With
Worksheets(akt_lap).Activate
Selection.Activate
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub
Új hozzászólás Aktív témák
- Azonnali VGA-s kérdések órája
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- sziku69: Szólánc.
- Battlefield 6
- Villanyszerelés
- droidic: Windows 11 önállóság nélküli világ: a kontroll új korszaka
- Ford topik
- OFF TOPIC 44 - Te mondd, hogy offtopic, a te hangod mélyebb!
- Építő/felújító topik
- Anglia - élmények, tapasztalatok
- További aktív témák...
- Dell Precision 5560 i7-11850H FHD+ 100%sRGB 32GB 1000GB Nvidia Quadro T1200 1 év teljeskörű gar!
- GYÖNYÖRŰ iPhone 16 Pro 128GB Desert Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS3674, 99% Akksi
- Honor X7b 128GB, Kártyafüggetlen, 1 Év Garanciával
- Keresünk dokkolókat
- LG 65QNED86T3A / QNED / 65" - 164 cm / 4K UHD / 120Hz / HDR Dolby Vision / FreeSync Premium / VRR
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő

Fferi50
