-
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
- Xiaomi Pad 8 Pro – a hardver felnőtt a névhez
- TP-LINK routerek
- Fejhallgató erősítő és DAC topik
- Futás, futópályák
- Bemutatkozott a Poco X7 és X7 Pro
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- One otthoni szolgáltatások (TV, internet, telefon)
- Gyúrósok ide!
- Kerékpársportok
- További aktív témák...
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- PC Game Pass előfizetés
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- MS SQL Server 2016, 2017, 2019
- -75% Dell XPS 13 (9320) i7-1260P 16GB Ram/1TB SSD FHD+ Gari
- BESZÁMÍTÁS! Asus B560M i5 11400 16GB DDR4 512GB SSD RTX 3060 12GB Formula Air Mesh G3 Adata 600W
- Vállalom telefonok,tabletek javítását ,(szoftveres hibát is,frp lock-ot is)márkától fügetlenűl
- Apple iPhone 15 Pro 128GB,Újszerű,Dobozaval,12 hónap garanciával
- Apple MacBook Pro 13" M2 (2022) 8GB / 256GB asztroszürke
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50