-
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
- New World - az új Amazon MMORPG
- Kételkedsz még a Marathonban? Nézz meg egy teljes kört!
- Kormányok / autós szimulátorok topikja
- Vicces képek
- Samsung Galaxy S25 - végre van kicsi!
- Fotók, videók mobillal
- Gitáros topic
- Philips LCD és LED TV-k
- exHWSW - Értünk mindenhez IS
- SSD kibeszélő
- További aktív témák...
- Clevo 1060 6GB Mxm 3.1 laptop videó kártya ingyen házhoz szálitással
- iKing.Hu - Apple iPhone 15 Pro Max Black Titanium 100% Akku
- Samsung Galaxy Watch5 LTE 40mm, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓ!!!! Dell Precision 3571 4G LTE i7-12700H 16GB 512GB FHD RTX A1000 4GB 1 év teljeskörű garancia
- Bomba ár! Dell Latitude E6430 - i5-3GEN I 4GB I 320GB I HDMI I 14" HD+ I W10 I Garancia!
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50