Tracciare nominativo di chi modifica il file

[systemcrack]

Ciao ragazzi torno a richiedere il vostro aiuto riguardo all'interazione tra due files (inizialmente trattata in questo post).

I due files in questione sono utilizzati uno "P.SIDERURGICO - ufficio.xlsx" da noi in ufficio e l'altro "LocMerce - piazzale.xlsm" dai ragazzi del piazzale (in un altro ufficio).

Nel file "P.SIDERURGICO - ufficio.xlsx" c'è un range di celle che riceve i dati dal file "LocMerce - piazzale.xlsm" e viceversa.
Ora siccome il file LocMerce è utilizzato a rotazione da più persone sullo stesso pc (che ha un unico account di accesso), che a volte fanno degli errori.
Mi chiedevo se fosse possibile creare una finestra di accesso in cui chi modifica il file in quel momento deve inserire un nominativo per poter eseguire le modifiche.
Eseguita la modifica, nella riga rispettiva della cella modificata comparirà il nominativo, la data e l'ora della modifica.

Sto sognando l'impossibile o c'è un modo?

Qui trovate i due files

[Marius44]

Ciao
Mi sembra una soluzione molto soft, anche si il modo ci sarebbe.
Io mi chiamo Mario e quando apro il file mi si chiede (con una InputBox) di inserire il nome. Siccome sono uno sgamato (dire poco corretto) metto Marco. Come fai a controllarlo?

Ciao,
Mario

[Dylan666]

volevo suggerire di usare una Macro con objNetwork.UserName ma poi si pone il problema di dove mettere il valore in modo che non sia "alterabile" e alla fine qualunque sotterfugio rimane "soft" come dice Marius44.

Perché alla fine la verità è una: Excel non controlla gli accessi (non è un sistema operativo o un gestionale) non macina dati all'infinito e non li storicizza (non è un database), non è una interfaccia grafica, non è un validatore di dati. Fa un po' tutte queste cose, ma non è il suo mestiere.

Allora non si può forzare, aggiustare, accroccare per fargli fare 1000 cose con stabilità e sicurezza vicino a zero.
Cioè, io capisco la piccola impresa che non vuole spendere, ma veramente se passa un audit sul GDPR, sulla sicurezza informatica o ma anche solo sui flussi qualcuno passa un guaio...

Ma se ben ricordo a questo discorso siamo già arrivati:
viewtopic.php?t=111798

[Anthony47]

Quindi qualcosa si puo' fare ma senza nessuna parvenza di affidabilità, veridicità e privacy.
Se, con questi limiti, la cosa ti interessa allora dovresti meglio dettagliare quando e dove vuoi scrivere qualcosa; il "qualcosa" e' limitato a un valore fornito dall'utente all'apertura del file piu' eventuali data/ora e indirizzo dei dati modificati.

Ciao

[systemcrack]

Buon giorno a tutti ragazzi, comprendo perfettamente le vostre perplessità e si avete ragione.. ci siamo già arrivati.. in passato sono arrivato ai ferri corti con una persona in direzione che mi aveva puntato, ma che ora non c'è più.
L'accanimento che vi era nei miei confronti, aveva innescato una paranoia a 365 gradi, che mi aveva portato al post d'avviso.
Ora la situazione è differente non è perfetta comunque, dal momento che i ragazzi del piazzale usano un computer in 6-7 con un unico account.
Ad ogni modo non credo proprio che da questo nascerà un problema, ne sono certo al 98%.
C'è inoltre una premessa da fare, questa modifica al file non è per "beccare/castigare" qualcuno.. è richiesta proprio dai ragazzi del reparto che essendo in tanti, fanno confusione e non ricordano chi ha scritto dove e quando (non sono rincoglioniti, ma vanno e vengono da fuori/piazzale e non usano frequentemente il pc).

Ragionavo per riuscire ad aggirare il problema sollevato da Dylan, invece che far inserire un nominativo dall'utente, non si potrebbe visualizzare un menù a tendina in cui selezionare i diminutivi dei ragazzi ( es. CIR, GM, MP, ecc, ecc)?

Dopo tutta questa prosaica premessa espongo la mia idea che era di lavorare solo sul file LocMerce - piazzale.xlsm in cui vorrei che all'apertura del file si apra una finestrella (o con il menù oppure faccio inserire il diminutivo direttamente dai ragazzi).
Il range di celle che vengono modificate direttamente dai ragazzi sono le colonne F (da F3 a F1000) e G (da G3 a G1000) ed io vorrei che quando viene eseguita una modifica in una delle due colonne F o G o entrambe nella colonna H nella cella sulla stessa riga comparisse una sorta di dicitura es: "modifica di MP del 30/05/22 alle ore 13.30".
Allego uno screen per essere maggiormente esaustivo.

[Marius44]

Ciao
Vista la "leggerezza" della protezione di Excel secondo me non risolvi nulla.
Forse, e ripeto forse, si potrebbe utilizzare il menu a tendina coi nomi (o diminutivi) ma potresti integrarlo con l'ulteriore inserimento di una psw univoca; si continua solo se il nome selezionato e la psw corrispondono a quanto memorizzato.
Ma, mi ripeterò fino alla noia, non esiste in Excel una "vera" protezione.
Ciao,
Mario

[systemcrack]

Ciao
Vista la "leggerezza" della protezione di Excel secondo me non risolvi nulla.
Forse, e ripeto forse, si potrebbe utilizzare il menu a tendina coi nomi (o diminutivi) ma potresti integrarlo con l'ulteriore inserimento di una psw univoca; si continua solo se il nome selezionato e la psw corrispondono a quanto memorizzato.
Ma, mi ripeterò fino alla noia, non esiste in Excel una "vera" protezione.
Ciao,
Mario

Ciao Mario, intanto grazie per l'interesse, per quanto riguarda la sicurezza della "non infrazione" non mi interessa più di tanto perché serve solo per tenere traccia delle modifiche.

[Marius44]

Ciao
Allora, segui quanto detto appresso.
Nella stessa cartella in cui c'è il file da controllare crea un Documento di testo e denominalo "reg_acc" (cioè registro accessi.
Nel file da controllare inserisci in ThisWorkBook

Codice: Seleziona tutto

Public strNome As String
Public datData As Date

Sub Workbook_Open()
    Do
    strNome = InputBox("Qual'è il tuo nome?" & vbNewLine & "Digitare 'Esci' per chiudere il file.", "Registrazione utente")
    datData = Now
    If StrConv(strNome, 1) = "ESCI" Then
        ActiveWorkbook.Save
        ActiveWindow.Close
    End If
'xxxxxxxxxxxxxxxxxxxxxxx
    Loop While strNome = ""
    nomepercorso = ActiveWorkbook.Path & "\reg_acc.txt"
    If Dir(nomepercorso, vbNormal) = "" Then
        Open nomepercorso For Output As #1
        Print #1, "Data accesso", ",", "Nome"
        Close #1
    End If
    Open nomepercorso For Append As #1
    Print #1, strNome, datData
    Close #1
End Sub


In Modulo inserisci questo codice

Codice: Seleziona tutto

Option Explicit
Dim RecordCorrente, NumCampi, Matrice(), Campi, NumRec

Sub UsoDelFile()
Dim np As String, MioTest As String, dat As String, mes As String
Dim FileNum As Integer, R As Integer, C As Integer, i As Integer
    np = ActiveWorkbook.Path & "\reg_acc.txt"   'np=nomepercorso
    FileNum = FreeFile()
    Open np For Input As #FileNum
    Line Input #FileNum, MioTest
    Close #FileNum
    Campi = Split(MioTest, ",")
    NumCampi = UBound(Campi) + 1
    ReDim Campi(1 To NumCampi)
    Close
    FileNum = FreeFile()
    R = 0
    Open np For Input As #FileNum
    For C = 1 To NumCampi
    Input #FileNum, Campi(C)
    Next
    Do While Not EOF(FileNum)
        R = R + 1
        ReDim Preserve Matrice(1 To NumCampi, 1 To R)
        For C = 1 To NumCampi
            Input #FileNum, Matrice(C, R)
        Next
    Loop
    Close #FileNum
    NumRec = UBound(Matrice, 2)
    For i = 1 To NumRec
        dat = Right(Matrice(1, i), 20)
        If IsDate(dat) Then
            dat = Trim(dat)
            If Left(dat, 10) = Left(Now, 10) Then
                mes = mes & Matrice(1, i) & vbLf
            End If
        End If
    Next
    MsgBox mes
End Sub

Sub QuanteVolte()
Dim np As String, MioTest As String, dat As String, mes As String
Dim FileNum As Integer, R As Integer, C As Integer, i As Integer
    np = ActiveWorkbook.Path & "\reg_acc.txt"   'np=nomepercorso
    FileNum = FreeFile()
    Open np For Input As #FileNum
    Line Input #FileNum, MioTest
    Close #FileNum
    Campi = Split(MioTest, ",")
    NumCampi = UBound(Campi) + 1
    ReDim Campi(1 To NumCampi)
    Close
    FileNum = FreeFile()
    R = 0
    Open np For Input As #FileNum
    For C = 1 To NumCampi
    Input #FileNum, Campi(C)
    Next
    Do While Not EOF(FileNum)
        R = R + 1
        ReDim Preserve Matrice(1 To NumCampi, 1 To R)
        For C = 1 To NumCampi
            Input #FileNum, Matrice(C, R)
        Next
    Loop
    Close #FileNum
    NumRec = UBound(Matrice, 2)
    For i = 1 To NumRec
        dat = Matrice(1, i)
        dat = Trim(dat)
        mes = mes & Matrice(1, i) & vbLf
    Next
    MsgBox mes
End Sub


Associa le due Sub a due pulsanti (non ActiveX).

Nel primo codice potresti inserire il controllo di eventuale psw dove ho indicato 'xxxxxxxxxxxxxxxxx

Prova e fai sapere. Ciao,
Mario

PS - Ovviamente nel mio esempio il file da controllare è uno solo. Lascio a te la cura delle variazioni eventuali visto che tu hai due files.

[Anthony47]

...ad esempio:
1) Su foglio TIP.MERCE, in D1:Dxx crei un elenco di nickname che le persone useranno; in D1 inserire la dicitura "Scegli Utente", funzionera' da Intestazione dell'elenco.

2) Sul foglio LOC.MERCE inserisci una "Casella di riepilogo" (ListBox) attingendo ai "Controlli ActiveX"; poi imposti le sue proprieta:
-come ListFillRange inserisci TIP.MERCE!D2:Dxx
-come LinkedCell inserisci TIP.MERCE!G1
-come ListStyle io suggerisco 1-fmListStyleOption
-come ColumnsHeads scegli True
-le altre dovrebbero andare bene quelle di default

3) Nel vba, in testa alla Sub Workbook_Open aggiungiamo la selezione dell'Utente:

Codice: Seleziona tutto

Private Sub Workbook_Open()
Dim Ckwb As Workbook, myTim As Single
'
Sheets("TIP.MERCE").Range("G1").ClearContents
Sheets("LOC.MERCE").Select
With ActiveSheet.Shapes.Range(Array("ListBox1"))
    .Visible = True
    .Top = ActiveWindow.VisibleRange.Cells(2, 3).Top * 1.1
    .Left = ActiveWindow.VisibleRange.Cells(2, 3).Left * 1.1
End With
myTim = Timer
Do
'attesa scelta:
    DoEvents: DoEvents
    Application.Wait (Now + TimeValue("0:00:01"))
    If Sheets("TIP.MERCE").Range("G1") <> "" Then Exit Do
    If (Timer - myTim) > 60 Or Timer < myTim Then
    'uscita per TimeOut=60 sec
        MsgBox ("Nessuna scelta fatta")
        Sheets("TIP.MERCE").Range("G1").Value = "NonSelezionato"
        Exit Do
    End If
    DoEvents: DoEvents
Loop
'Nascondi ListBox:
ActiveSheet.Shapes.Range(Array("ListBox1")).Visible = False
'Continua il codice originale:
FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
'etc etc


4) Infine modifichiamo la Sub Worksheet_Change del foglio LOC.MERCE:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRan As String
Dim myC As Range, Worked As Range
'
myRan = "F3:G1000"
Set Worked = Application.Intersect(Target, Range(myRan))
If Not Worked Is Nothing Then
    Application.EnableEvents = False
    For Each myC In Worked
        'Inserisci log in colonna H:
        Cells(myC.Row, "H").Value = "Utente: " & Sheets("TIP.MERCE").Range("G1").Value & " - Time: " & Format(Now, "dd-mmm-yy hh:mm")
    Next myC
    Application.EnableEvents = True
End If
'Continua il codice originale:
myRan = "F3:F1000"       '<<< L'area per i cui cambiamenti viene subito fatto un File Save
'etc etc


Salvare ora il file e riaprirlo:
-all'apertura verra' chiesto di scegliere l'utente di lavoro; dopo un timeout di 60 secondi si imposta un utente di default

A questo punto, le modifiche all'area F3:G1000 provocheranno una registrazione in colonna H; il formato e' del tipo Utente: CipCiop - Time: 30-nov-22 12:08 ma puo' essere modificato a piacere

Ciao a tutti


EDIT:
Mario mi ha preceduto con la sua proposta; deve avere una tastiera piu' veloce della mia
Spero abbiamo detto due cose diverse così SystemCrack puo' scegliere

[systemcrack]

Ciao
Allora, segui quanto detto appresso.
Nella stessa cartella in cui c'è il file da controllare crea un Documento di testo e denominalo "reg_acc" (cioè registro accessi.
Nel file da controllare inserisci in ThisWorkBook

Codice: Seleziona tutto

Public strNome As String
Public datData As Date

Sub Workbook_Open()
    Do
    strNome = InputBox("Qual'è il tuo nome?" & vbNewLine & "Digitare 'Esci' per chiudere il file.", "Registrazione utente")
    datData = Now
    If StrConv(strNome, 1) = "ESCI" Then
[....]
[....]

Nel primo codice potresti inserire il controllo di eventuale psw dove ho indicato 'xxxxxxxxxxxxxxxxx

Prova e fai sapere. Ciao,
Mario

PS - Ovviamente nel mio esempio il file da controllare è uno solo. Lascio a te la cura delle variazioni eventuali visto che tu hai due files.

Provando uno per volta.. comincio con il suggerimento di Mario e parto subito con il primo dubbio:
Il range di nomi da selezionare in quale parte di codice è?

[systemcrack]

Altri dubbi :

- Inserendo il codice così com'è ricevo due erroi 1ERRORE-WORKBOOK-OPEN e 2 ERRORE-NOME-NON-UNIVOCO
- I bottoni che dovrei attribuire, non ho capito dove li dovrei inserire?

[Marius44]

Ciao
Il mio è solo un "suggerimento" su come fare.
Non ci sono nomi ed il file è uno solo. Fra l'altro nel tuo post iniziale io trovo un solo file allegato e non due.
E' meglio se approfondisci il codice di Anthony

Ciao,
Mario

[systemcrack]

Ciao
Il mio è solo un "suggerimento" su come fare.
Non ci sono nomi ed il file è uno solo. Fra l'altro nel tuo post iniziale io trovo un solo file allegato e non due.
E' meglio se approfondisci il codice di Anthony

Ciao,
Mario

Ciao Mauro, se tu avessi scaricato il file avresti visto che è uno zip che contiene due file excel (i due file premessi nei post precedenti).
Come già detto ho allegato entrambi i files in modo da dare la situazione più completa possibile, ma in realtà quello da modificare sarà uno solo: LocMerce - piazzale.xlsm.
Ti chiedo di aver pazienza perché non sono praticissimo di vba, ma pastrocchio parecchio con css e html.. se hai pazienza e mi spieghi i passaggi cruciali poi ci arrivo anche io.
Per esempio il primo errore che ho segnalato sarà dovuto dal fatto che ho già una sub workbook open

[Marius44]

Ciao
Vero è che ho qualche ... anno ma non credo di essere ancora rinco....
Ho scaricato quanto presente nel primo post, ho visto che è zippato ma dentro c'è solo P.SIDERURGICO - ufficio

Se trovo un po' di tempo vedo di realizzare qualcosa (anche se ritengo quello di Anthony appropriato).
Ovvio che WorkBook_Open deve essere una sola.

Ciao,
Mario

[systemcrack]

Ciao
Vero è che ho qualche ... anno ma non credo di essere ancora rinco....
Ho scaricato quanto presente nel primo post, ho visto che è zippato ma dentro c'è solo P.SIDERURGICO - ufficio

Se trovo un po' di tempo vedo di realizzare qualcosa (anche se ritengo quello di Anthony appropriato).
Ovvio che WorkBook_Open deve essere una sola.

Ciao,
Mario

Ciao Mario assolutamente non era mia intenzione darti del rinvoglionito, ma per la seconda volta ti garantisco, dopo aver controllato, che i files all'interno del pacchetto sono 2. Ti allego lo screen fatto or ora con il telefono dopo aver scaricato per la seconda volta il file.

Che sia dovuto dal fatto che la compressione è realizzata con 7zip?

[Anthony47]

Se puo' aiutare a debuggare la situazione, anche io vedo i DUE file; uso 7Zip, ma vedo due file anche se (dopo aver fatto download del file zippato) faccio "Apri con /Esplora risorse"
Ciao

[Marius44]

Buongiorno a tutti
Confermo che io vedo solo un file.
Comunque ho realizzato quanto trovate in allegato.

La cartella contiene tre file: File_ONE, File_TWO e reg_acc (quest'ultimo è un file di testo)

In File_ONE - Foglio1 vi sono due pulsanti
- Fino alla data - Mostra le aperture del file fino alla data indicata
- Totale utilizzi - Mostra TUTTE le aperture del file
Non ho previsto un pulsante per eventuale "pulizia"
Queste le macro associate ai pulsanti

Codice: Seleziona tutto

Option Explicit

Sub LeggiUltimi()
Dim np As String, x, gg
Dim miotest(), a, i, mes As String

gg = InputBox("Inserire una data (gg/mm/aaaa)", "Utilizzi fino alla data")
If gg = "" Then Exit Sub
np = ActiveWorkbook.Path & "\reg_acc.txt"
Open np For Input As #1
a = 1
Do While Not EOF(1)
  Input #1, x
  ReDim Preserve miotest(1 To a)
  miotest(a) = Trim(x)
  a = a + 1: x = ""
Loop
Close #1
For i = 1 To UBound(miotest)
  If CDate(Left(Right(miotest(i), 19), 10)) <= CDate(gg) Then
    mes = mes & miotest(i) & vbLf
  End If
Next i
MsgBox mes
End Sub

Sub LeggiTutti()
Dim np As String, x
Dim miotest(), a, i, mes As String
np = ActiveWorkbook.Path & "\reg_acc.txt"
Open np For Input As #1
a = 1
Do While Not EOF(1)
  Input #1, x
  ReDim Preserve miotest(1 To a)
  miotest(a) = x
  a = a + 1: x = ""
Loop
Close #1
For i = 1 To UBound(miotest)
  mes = mes & miotest(i) & vbLf
Next i
MsgBox mes
End Sub


In File_TWO - Foglio1 trovate:
- in J2 una Convalida dati che assume i dati che ho inserito (per mia comodità) in P1:P4
ATTENZIONE: In Q1:Q4 vi sono le password relative ai nomi della colonna precedente MA DI COLORE BIANCO
- ho inserito una UserForm (MaskPsw) con una TextBox e due pulsanti
- nel Modulo del Foglio1 ho inserito il seguente codice

Codice: Seleziona tutto

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim psw As String, flg As String, perc As String
Dim dt As Date
If Not Intersect(Target, Range("J2")) Is Nothing Then
  If Target = "" Then Exit Sub
  MaskPsw.Show vbModal 'chiede inserimento psw
End If
End Sub


- nei due pulsanti della UserForm ho inserito il seguente codice (uno per ciascun pulsante):

Codice: Seleziona tutto

Option Explicit

Private Sub cmdEsci_Click()
Unload MaskPsw
End Sub

Private Sub cmdEsegui_Click()
Dim psw As String, flg As String, perc As String, Utente As String
Dim dt As Date
Utente = Sheets(1).Range("J2")
psw = TextBox1.Text
flg = Application.WorksheetFunction.VLookup(Utente, Sheets(1).Range("P1:Q4"), 2, 0) 'confronta
If flg <> psw Then
  MsgBox "La psw non è corretta" 'se errata avvisa ed esce
  Exit Sub
End If
'controllo superato
dt = Now
perc = ActiveWorkbook.Path & "\reg_acc.txt"
If Dir(perc, vbNormal) = "" Then
  Open perc For Output As #1
  Print #1, "Nome", "Data accesso"
  Close #1
End If
Open perc For Append As #1
Print #1, Utente, dt
Close #1
MsgBox "Password corretta." & vbLf & "Buon lavoro.", vbExclamation, "Controllo Password"
Unload MaskPsw
End Sub


Questo il link https://www.dropbox.com/sh/o6r2gciat28bhbv/AABQtMf9FOf2Ojcly0rqRhr0a?dl=0

Ciao,ùMario

[systemcrack]

Buongiorno a tutti
Confermo che io vedo solo un file.
Comunque ho realizzato quanto trovate in allegato.

La cartella contiene tre file: File_ONE, File_TWO e reg_acc (quest'ultimo è un file di testo)

In File_ONE - Foglio1 vi sono due pulsanti
- Fino alla data - Mostra le aperture del file fino alla data indicata
- Totale utilizzi - Mostra TUTTE le aperture del file
Non ho previsto un pulsante per eventuale "pulizia"
Queste le macro associate ai pulsanti

Codice: Seleziona tutto

Option Explicit

Sub LeggiUltimi()
Dim np As String, x, gg
Dim miotest(), a, i, mes As String

gg = InputBox("Inserire una data (gg/mm/aaaa)", "Utilizzi fino alla data")
[....]
[....]
[....]
Close #1
MsgBox "Password corretta." & vbLf & "Buon lavoro.", vbExclamation, "Controllo Password"
Unload MaskPsw
End Sub


Questo il link https://www.dropbox.com/sh/o6r2gciat28bhbv/AABQtMf9FOf2Ojcly0rqRhr0a?dl=0

Ciao,ùMario

Grazie Mario per i files di esempio, sebbene non siano esattamente quello che cercavo, li apprezzo.. mi piacciono.. provo a vedere se li riesco ad adattare alle mie esigenze.

[systemcrack]

Sto dando un'occhiata anche al tuo Antony.. c'è una cosa che non capisco:

.
-come LinkedCell inserisci TIP.MERCE!G1

La casella G1 del file Tip.MERCE a che serve?
La seconda domanda è.. invece che creare un altro file, posso fare tutto sullo stesso: LocMerce - piazzale?

[Dylan666]

Se puo' aiutare a debuggare la situazione, anche io vedo i DUE file; uso 7Zip, ma vedo due file anche se (dopo aver fatto download del file zippato) faccio "Apri con /Esplora risorse"
Ciao

Il problema è che il file "LocMerce - piazzale.xlsm" è stato zippato con il flag per i file nascosti.
Se non ne abiliti la visualizzazione nella cartella di estrazione non lo vedi