- Mobil flották
- Apple Watch Ultra - első nekifutás
- Honor 400 - és mégis mozog a kép
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Amazfit T-Rex 3 - prehisztorikus idő
- One mobilszolgáltatások
- Fotók, videók mobillal
- iPhone topik
- Samsung Galaxy A54 - türelemjáték
- Motorola Razr 60 Ultra - ez a kagyló könnyen megfő
-
Mobilarena
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
-
poffsoft
veterán
válasz
Belnir
#29469
üzenetére
Option Explicit
Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
Dim fso As Object
Dim logfile As Object
' If Target.Count <> 1 Then Exit Sub
' If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set logfile = fso.OpenTextFile("\eleresi_ut\log.txt", 8, True)
logfile.WriteLine ("VÁLTOZTAT" & " - " & Format(Now, "YYYY.MM.DD hh:mm:ss") & " - " & Environ$("username") & " - " & Application.UserName & " - " & Environ$("computername") & " - " & Target.Parent.Name & " - " & Target.Address & " - " & aktualis & " - " & Target(1, 1).Value & " -+")
logfile.Close
Set logfile = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub -
poffsoft
veterán
válasz
Belnir
#29454
üzenetére
az if aktualis=
vizsgàlat miért kell?
ha a ws_change eventben vagy, tuti, hogy szerkesztettek, logold.
plusz ha valaki több cellát módosít, töröl egyszerre, arról sincs logod.
esetleg az
if target.count
helyett az értéket csak az 1. cellában nézd:
target(1,1).value
?
a writeline végére még beszúrnék egy lezáró "-" -t, hogy látsszon az üres érték is (ami a törlés). -
bsh
addikt
válasz
Belnir
#29421
üzenetére
azért az jelentősen más, nem csak amolyan "átírjuk oszt' jóvan"
itt egy ilyen faék megoldás. az egyszerűség kedvéért a log fájlt először külön hozd létre (egy üres excel fájl) és a megfelelő elérési utat írd bele.
Private Sub Workbook_Open()
Call WriteToLog(Application.UserName, "Megnyitás")
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Call WriteToLog(Application.UserName, "Bezárás")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Call WriteToLog(Application.UserName, Sh.Name & " változtatás")
End Sub
Private Sub WriteToLog(ByVal Who As String, ByVal What As String)
Dim NewXL As New Excel.Application
NewXL.Visible = False
Dim Log As New Excel.Workbook
Set Log = NewXL.Workbooks.Open("Z:\logfájl\elérési\útja\log.xlsx") 'A fájlt először kézzel hozd létre!
Dim LastRow As Long
LastRow = Log.ActiveSheet.Cells(Log.ActiveSheet.Rows.Count, 1).End(xlUp).Row
Log.ActiveSheet.Cells(LastRow + 1, 1) = Format(Now, "YYYY.MM.DD hh:mm:ss")
Log.ActiveSheet.Cells(LastRow + 1, 2) = Who
Log.ActiveSheet.Cells(LastRow + 1, 3) = What
Log.Save
Log.Close
Set Log = Nothing
Set NewXL = Nothing
End Sub -
bsh
addikt
válasz
Belnir
#29382
üzenetére
túlbonyolítod. excelben le lehet simán védeni jelszóval a lapot módosítások ellen, vagy akár az egész munkafüzetet is.
de makróval is megoldható, csak ugye a makrók letilthatóak...én mondtam, hogy sokkal egyzserűbb egy külön logfájlba menteni a megnyitásokat/mentéseket/akármiket.
-
#29381
szatocs1981
aktív tag
Belnir
#29379
szatocs1981
aktív tag
válasz
Belnir
#29379
üzenetére
Windows alatt levéded (read_only) és magadat beteszed kivételbe.
PS: mondjuk ez akkor teljesen ellenben van az elözö kikötéseddel, miszerint:
"Azt szeretném, hogy:
1. valaki megnyitja a munkafüzetet
2. a megnyílás pillanatában mentsen automatikusan egyet, beírva, hogy ki mikor hol stb, ahogy most is faszán megy" -
poffsoft
veterán
válasz
Belnir
#29358
üzenetére
majd belejössz!
Én amúgy a "Rejtett" lapot minden futtatáskor rejtetté is tenném, biztos ami tuti... Ha nem látják, nem szerkesztenek bele...
Az Application.ScreenUpdating = False után: (de ez nem biztos, hogy kell..)
Worksheets("Rejtett").Visible = xlSheetVisible
Az Application.ScreenUpdating = True elé:
Worksheets("Rejtett").Visible = xlSheetVeryHidden
Delila_1: tudom, olvastam
. Örülök, hogy használod 
-
Delila_1
veterán
-
Delila_1
veterán
válasz
Belnir
#29332
üzenetére
A füzetben egy lapot átnevezel, legyen a neve Rejtett.
Az első sorba A1-től H1-ig beírod a címeket:
Akció | Változás helye | Időpont | Változás előtt | Vált. után | Felh. neve | PC neve | Felh. domainEzt a lapot elrejtheted.
A füzetedben Alt+F11-re bejön a VB szerkesztő.
Bal oldalon kiválasztod a füzeted nevét. Ha a név előtt + jel van, rákattintasz.
Megjelenik (többek közt) a ThosWorkbook lap. Erre kattintasz. Jobb oldalon kapsz egy nagy üres felületet.
Oda másold be a lenti makrót.Private Sub Workbook_Open()
Dim lastrow As Long
Application.ScreenUpdating = False
With Worksheets("Rejtett")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
With .Range("A" & lastrow)
.Offset(0, 0).Value = "OPEN"
.Offset(0, 1).Value = ThisWorkbook.FullName
.Offset(0, 2).Value = Now()
.Offset(0, 3).Value = "'*"
.Offset(0, 4).Value = "'*"
.Offset(0, 5).Value = Environ$("username")
.Offset(0, 6).Value = Environ$("computername")
.Offset(0, 7).Value = Environ$("userdomain")
End With
End With
Application.ScreenUpdating = True
End SubHagyj ki alatta egy sort. Válassz az Open helyett BeforeClose-t, majd Workbook_AfterSave-et a kép szerinti legördülőben.
Kaptál két Private Sub - End Sub párost. Ezek közé másold be a fenti makró belsejét (a Private Sub és End Sub közötti részt).
Makróbarátként kell mentened a füzetet.
-
bsh
addikt
válasz
Belnir
#29332
üzenetére
kód a ThisWorkbook-ba:
Private Sub Workbook_Open()
On Error GoTo xit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Logfile = FSO.OpenTextFile("Z:\ez\valami\szerveren\legyen\logfile.log", 8, True)
Logfile.WriteLine (Format(Now, "YYYY.MM.DD hh:mm:ss") & " - " & Application.UserName)
Logfile.Close
Set Logfile = Nothing
Set FSO = Nothing
xit:
End Sub
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Vírusirtó, Antivirus, VPN kulcsok
- Sea of Thieves Premium Edition és Egyéb Játékkulcsok.
- BESZÁMÍTÁS! Gigabyte B450 R7 5700X 32GB DDR4 512GB SSD RX 6700XT 12GB Rampage SHIVA be quiet! 650W
- Új és használt laptopok , üzletitől a gamerig , kedvező áron. Garanciával !
- Motorola E40 64GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon Felvásárlás!! iPhone 14/iPhone 14 Plus/iPhone 14 Pro/iPhone 14 Pro Max
- HGST HUH721010AL5200 10TB 7.2k SAS HDD, DELL branded, nettó 38000Ft + ÁFA, 1 év garancia
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest