- Android alkalmazások - szoftver kibeszélő topik
- Mobil flották
- Milyen okostelefont vegyek?
- Vivo X200 Pro - a kétszázát!
- Samsung Galaxy Z Fold7 - ezt vártuk, de…
- Samsung Galaxy A52s 5G - jó S-tehetség
- Sony Xperia 1 VII - Látod-e, esteledik
- A Pixel 10 minden színben és oldalról
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
- Xiaomi Mi 10T Pro - a házon belüli ellenfél
Hirdetés
-
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.
-
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
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Eladó Steam kulcsok kedvező áron!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- HIBÁTLAN iPhone 13 Pro 256GB Graphite -1 ÉV GARANCIA - Kártyafüggetlen, MS3073, 100% Akkumulátor
- REFURBISHED és ÚJ - HP USB-C/A Universal Dock G2 docking station (5TW13AA) (DisplayLink)
- Apple iPhone 16 Pro 128GB, Kártyafüggetlen, 3 Év Garanciával
- Apple iPhone 13 128GB Kártyafüggetlen 1 év Garanciával
- Tomb Raider I-II-III Remastered Deluxe Edition / Bontatlan/ Számla /
Állásajánlatok
Cég: FOTC
Város: Budapest