Фиксирование текущей даты

Автор Snyppi, 14 января 2020, 16:20

0 Пользователи и 1 гость просматривают эту тему.

Snyppi

Здравствуйте, пытаюсь сделать так, чтобы фиксировалась дата редактирования ячейки. Знаю, темы тут уже такие были, и я делал по этому документу https://forumooo.ru/index.php/topic,6577.msg42231.html#msg42231 но формула отсюда вообще не работает, либо ошибка 523. Сделал по своей логике, но программа отказывается выводить значение в ячейке, пишет ошибку 523. И как бы я не менял формулу, то пишет ошибку, то дату выводит неверную (30.12.99). Макросы начинал делать в документе, но сохранил, открыл документ и они все исчезли

bigor

Да там же JohnSUN и пишет:
ЦитироватьНо гарантировать, что после сохранения и повторного открытия книги мы увидим ту же дату, нельзя – разные версии по-разному ведут себя в этой ситуации

Поэтому макрос надежнее
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

economist

А если использовать штатный функционал (включить оба пункта):

- Правка/Отслеживать изменения
- Сервис/Совместно использовать 

В результате видны в комментариях дата/время изменений, кто изменил и что на что. 
 
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

Snyppi

Цитата: Bigor от 14 января 2020, 16:56Поэтому макрос надежнее
Хорошо, поставил я макросы. onChangeSingleCell работает.  onChangeRange скопировал тоже самое, поменял ячейки и не хочет никак работать. Естественно, макрос в событии листа меняю

REM  *****  BASIC  *****
Rem (©) Vladislav Orlov aka JohnSUN, Kyiv, 2017
Rem mailto:johnsun@i.ua


Option Explicit
Option Base  0

Sub onChangeSingleCell(oEvent As Variant)
Dim oCell As Variant
If oEvent.AbsoluteName = "$БУМАГА.$G$5" Then
oCell = oEvent.getSpreadsheet().getCellRangeByName("$БУМАГА.$G$4")
If oCell.getString()="" Then oCell.setFormula(Format(Now, "DD.MM.YYYY HH:mm:SS"))
EndIf
End Sub

Sub onChangeRange(oEvent As Variant)
Dim oSheet As Variant
Dim oCellWithData As Variant
Dim oChangedRanges As Variant
Dim oRangeToDate As Variant
Dim oRange As Variant
Dim oEditRange As Variant
Dim oRows As Variant
Dim oRow As Variant
Dim oCells As Variant
Dim oCell As Variant
Dim i As Long
On Error Resume Next
oSheet = oEvent.getSpreadsheet()
oCellWithData = oSheet.getCellRangeByName("G5:I35")
oChangedRanges = oCellWithData.queryIntersection(oEvent.getRangeAddress())
If IsEmpty(oChangedRanges) Then Exit Sub

oRangeToDate = oSheet.getCellRangeByName("G4:I4").queryEmptyCells()
If IsEmpty(oRangeToDate) Then Exit Sub
For Each oRange In oChangedRanges
oRows = oRange.getRows()
For i = 0 To oRows.getCount()-1
oRow = oRows.getByIndex(i)
oEditRange = oRangeToDate.queryIntersection(oRow.getRangeAddress())
If Not IsEmpty(oEditRange) Then
For Each oCell In oEditRange
oCell.setFormula(Format(Now, "DD.MM.YYYY HH:mm:SS"))
Next oCell
EndIf
Next i
Next oRange
End Sub

mikekaganski

А почему в макросе проверяются изменённые строки - oRows = oRange.getRows() и далее? Там же должны искаться изменённые данные в столбцах?
С уважением,
Михаил Каганский

Snyppi

Цитата: mikekaganski от 15 января 2020, 09:02Там же должны искаться изменённые данные в столбцах?
Как правильно написать для столбцов?

mikekaganski

Sub onChangeRange(oEvent As Variant)
Dim oSheet, oCellWithData, oChangedRanges, oRangeToDate, oRange, oEditRange, oCols, oCol, oCells, oCell
Dim i As Long
On Error Resume Next
oSheet = oEvent.getSpreadsheet()
oCellWithData = oSheet.getCellRangeByName("G5:I35")
oChangedRanges = oCellWithData.queryIntersection(oEvent.getRangeAddress())
If IsEmpty(oChangedRanges) Then Exit Sub

oRangeToDate = oSheet.getCellRangeByName("G4:I4").queryEmptyCells()
If IsEmpty(oRangeToDate) Then Exit Sub
For Each oRange In oChangedRanges
oCols = oRange.getColumns()
For i = 0 To oCols.getCount()-1
oCol = oCols.getByIndex(i)
oEditRange = oRangeToDate.queryIntersection(oCol.getRangeAddress())
If Not IsEmpty(oEditRange) Then
For Each oCell In oEditRange
oCell.setFormula(Format(Now, "DD.MM.YYYY HH:mm:SS"))
Next oCell
EndIf
Next i
Next oRange
End Sub
С уважением,
Михаил Каганский

Snyppi

mikekaganski, спасибо большое! Всё работает