Control de cambios

Otra vez molestando d2enri. Te pregunto ahora por un control de cambios que deseamos llevar en la base de datos, pero tenemos una macro que solo nos da la hora del cambio, pero no nos dice en que celda fue el cambio y no guarda histórico; solo se actualiza la hora cada vez que hay un cambio. La macro es esta:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewEntry As String
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Not Intersect(Target, Range("C1:HR3000")) Is Nothing Then
NewEntry = ""
NewEntry = Target
t = Time
If Target <> "" Then
c = Target.Row
Range("HS" & LTrim(Str(c))).Value = t
End If
End If
End Sub
No se si nos puedes colaborar con esta, si nos puede decir en que celda se hizo el cambio y nos guarde un histórico.

2 respuestas

Respuesta
1
Siguiendo con la lógica de tu código, agrega lo que está en negritas:
-
c = Target.Row
Range("HS" & LTrim(Str(c))).Value = t
Range("HT" & LTrim(Str(c))).Value = c.Address
-
No corre, me dice que requiere objeto y se ubica en la linea que agregue. Me puedes ayudar.
Listo.
En tu libro, nombra al final una hoja con el nombre "Historico" y con el siguiente código, tienes tu solución:
-
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Z As Range
 If Sh.Name = "Historico" Then Exit Sub
 If Target.Cells.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("C1:HR3000")) Is Nothing Then
  Set Z = Range("Historico!A1").CurrentRegion
  Range("Historico!A" & Z.Rows.Count + 1).Value = Time
  Range("Historico!B" & Z.Rows.Count + 1).Value = Target.Address
  Range("Historico!C" & Z.Rows.Count + 1).Value = IIf(Target = "", "DEL", Target.Value)
 End If
End Sub
-
No me sale nada.
¿Creaste la hoja "Historico"? Sin acento.
¿Insertaste el código? Debe ser en la sección ThisWorkbook
Respuesta
1
¿Has mirado en el control de cambios de excel?
En la ficha revisar esta proteger y compartir cambios
Pinchas en compartir con control de cambios si quieres pones contraseña y cuando alguien cambie algo se resalta la casilla
al situar el cursor sobre ella te indica la hora y el usuario que lo modifico caso de que sean varios usuarios
si no te sirve o lo que quieres es una hoja donde te guarde los cambios me lo dices y miraremos que podemos hacer
Si lo que se busca es una hoja donde se guarden todos esos cambios. Gracias por cualquier ayuda.
¿d2enri te olvidaste de mi?
No no me olvide pero estoy muy liado
Este fin de semana intentare hacerlo, pero aclarame ¿quieres un histórico de toda la página cada vez que se cambie algo?
Porque si lo hago como tu planteas cada vez que haces cambios los cambios anteriores desaparecerían.
Si un histórico de la base de datos de notas, y ese es el error que tenemos, que nos desaparece los cambios anterires sin guardar ningún registro. Gracias por cualquier ayuda.
Si pones este código cada vez que cierres y guardes el archivo te crea una página nueva en el libro con la copia de la hoja b.dato
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Sheets("B. NOTAS").Select
  Cells.Select
    Selection.Copy
    Sheets("B. NOTAS").Select
    Sheets.Add
    ActiveSheet.Paste
    Range("B2").Select
    Sheets("B. NOTAS").Select
    Application.CutCopyMode = False
End Sub
Si te vale me lo dices pues estoy intentando que ademas cuando la guarde te coloree las celdas que se modificaron
Gracias d2enri, te estoy muy agradecido
Si te valió cierra la pregunta
d2enri, si no te quita mucho tiempo lo del color en las celdas, me gustaría, pero si te va quitar mucho de tu tiempo me escribes para cerrar la pregunta.
¿Creo qué me guarda una copia de la base de datos pero me tocaría comparar una a una las celdas para darme cuenta cual cambiaron?
Le dedicare un rato en cuanto pueda
Gracias
d2enri, te cuento que ya la tengo la macro más avanzada, pero me registra los cambios de todo el libro y solo quiero que me controle los cambios de una sola hoja. Me puedes ayudar por fa.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Z As Range
 If Sh.Name = "Historico" Then Exit Sub
 If Target.Cells.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("A1:R3000")) Is Nothing Then
  Set Z = Range("Historico!A1").CurrentRegion
  Range("Historico!A" & Z.Rows.Count + 1).Value = Time
  Range("Historico!B" & Z.Rows.Count + 1).Value = Target.Address
  Range("Historico!C" & Z.Rows.Count + 1).Value = IIf(Target = "", "DEL", Target.Value)
 End If
End Sub
Gracias
Creo que ley por hay que ya lo tienes solucionado
Si no es así confírmamelo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas