Редактирование макроса переименование листов

[bsi]

Всем желаю здравия.
Имею макрос с кодом:

Код Выделить Развернуть

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
 
Option Explicit
 
Public Const SHEET_NAMES_RANGE = "A2:A18"
 
Function SheetName(pSheetNum As Integer) As String
    If pSheetNum > 0 And pSheetNum <= ThisComponent.Sheets.Count Then
        SheetName = ThisComponent.Sheets.getByIndex(pSheetNum - 1).Name
    Else
        SheetName = "Ошибка: номер листа вне диапазона"
    End If
End Function
 
Sub Обновить_список_листов()
    Dim oSheet As Object
    Dim aTOC As Variant
 
    oSheet = ThisComponent.CurrentController.ActiveSheet
    aTOC = Get_TOC_array(oSheet)
    If IsEmpty(aTOC) Then Exit Sub
 
    PrintArray oSheet, aTOC
End Sub
 
Private Function Get_TOC_array(oSheet As Object) As Variant
    Dim oSheets As Object, oCurSheet As Object
    Dim aNames() As String
    Dim i As Integer, n As Integer
 
    oSheets = ThisComponent.Sheets
    ReDim aNames(oSheets.Count - 1)
    n = 0
    For i = 0 To oSheets.Count - 1
        oCurSheet = oSheets.getByIndex(i)
        If oCurSheet.Name <> oSheet.Name Then
            aNames(n) = oCurSheet.Name
            n = n + 1
        End If
    Next i
 
    If n = 0 Then Exit Function
 
    Dim aTOC(1 To n, 1 To 1) As Variant
    For i = 1 To n
        aTOC(i, 1) = aNames(i - 1)
    Next i
    Get_TOC_array = aTOC
End Function
 
Private Sub PrintArray(oSheet As Object, aTOC As Variant)
    Dim oDoc As Object
    Dim oStartCell As Object, oCursor As Object
    Dim oClearRange As Object, oClearAddr As New com.sun.star.table.CellRangeAddress
    Dim r As Integer, nRows As Integer
 
    oDoc = ThisComponent
    oDoc.lockControllers()
 
    oStartCell = oSheet.getCellRangeByName(SHEET_NAMES_RANGE).getCellByPosition(0, 0)
    oCursor = oSheet.createCursorByRange(oStartCell)
    oCursor.collapseToCurrentRegion()
    oClearAddr = oCursor.RangeAddress
 
    ' стираем старый список целиком (он мог быть длиннее нового)
    oClearRange = oSheet.getCellRangeByPosition(oClearAddr.StartColumn, oClearAddr.StartRow, oClearAddr.StartColumn, oClearAddr.EndRow)
    oClearRange.clearContents(com.sun.star.sheet.CellFlags.VALUE Or com.sun.star.sheet.CellFlags.STRING Or com.sun.star.sheet.CellFlags.FORMULA)
 
    nRows = UBound(aTOC, 1)
    For r = 1 To nRows
        oSheet.getCellByPosition(oClearAddr.StartColumn, oClearAddr.StartRow + r - 1).setString(aTOC(r, 1))
    Next r
 
    oDoc.unlockControllers()
End Sub
 
Sub Обновить_имена_листов()
    ' в VBA это было Range.Value = Range.Value — "заморозка" формулы SheetName(...) в текст
    Dim oSheet As Object, oRange As Object, oCell As Object
    Dim oAddr As com.sun.star.table.CellRangeAddress
    Dim r As Integer, c As Integer
 
    oSheet = ThisComponent.CurrentController.ActiveSheet
    oRange = oSheet.getCellRangeByName(SHEET_NAMES_RANGE)
    oAddr = oRange.RangeAddress
 
    For r = oAddr.StartRow To oAddr.EndRow
        For c = oAddr.StartColumn To oAddr.EndColumn
            oCell = oSheet.getCellByPosition(c, r)
            If oCell.getString() <> "" Then
                oCell.setString(oCell.getString())
            End If
        Next c
    Next r
End Sub
Проблемы с этим кодом:
- не переименовываются листы если переименовываю в Листе Итог
- результат переименования листов выводится именно в 13-й по, счёту лист, а надо в самый левый лит.
- листы с 1-го по 12-й переименовываются как яз ярлыка листа так и из листа Итог, а остальные только переименовываются только из ярлыка листов.
Лист Итог должен находится справа от всех ярлыков листов, сейчас он 13-й по счёту и если я его передвигаю, результат переименования листов появляется в  13-ом по счёту листе а не в листе Итог.
Если найдётся специалист исправить это, просьба выслать файл с исправлением этих ошибок. В макросах я мало что понимаю.
Всем ответившим спасибо за помощь.
Файл приложил.
Вложения

[sokol92]

Сообщите "Сведения о версии".

[bsi]

Сообщите "Сведения о версии".

Что конкретно имелось ввиду? Код есть, Файл есть.

[sokol92]

LibreOffice. Меню / Справка / О программе LibreOffice, кнопка "Сведения о версии".
Содержимое буфера обмена скопировать в сообщение на этом форуме.

[bsi]

Версия LO 26.2 последние обновления сегодня.

[sokol92]

LibreOffice. Меню / Справка / О программе LibreOffice, кнопка "Сведения о версии".
Содержимое буфера обмена скопировать в сообщение на этом форуме.

[bsi]

Version: 26.2.4.2 (x86)
Build ID: 0229ac93fcf0d7cbc6376066c6f35021cef002dc
CPU threads: 2; OS: Windows 10 X86_32 (build 19045); UI render: Skia/Raster; VCL: win
Locale: ru-RU (ru_RU); UI: ru-RU
Calc: threaded
 Не могу понять куда скопировать. Так что ли?

[sokol92]

О прилагаемом примере.
В макросах нет комментариев, которые объясняют назначение макросов.

- не переименовываются листы если переименовываю в Листе Итог

Лист "Итог" отсутствует в приложенном к стартовому сообщению файлу.

Приведите точную последовательность действий, начиная от открытия файла, и поясните, какой результат получился и чем он отличается от ожидаемого Вами.
Альтернатива - спросите у автора макросов.

[bigor]

Ваш макрос очень похож на код из этой темы, а тот на код с ПланетыЕксель. Только почему-то процедуры Worksheet_Activate и Worksheet_Change в первоначальном варианте были на листе13 и в Libre события изменения названия листов не отрабатывали, а в текущем не привязаны ни к одному листу, но зато каким то образом в Libre отрабатывают.

[bsi]

Всем привет. К сожалению Приведите точную последовательность действий представить не могу т.к. код написал искусственный интеллект, а комментариев он не дал. Исходный код для интеллекта был взят из файла который я нашёл на одном из форумов по Excel и он заработал в LO Calc.Файл этот я высылаю.
Там вот такой код, но комментариев тоже нет.

Код Выделить Развернуть

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit

Public Const SHEET_NAMES_RANGE = "A2:A13"
   
Sub Обновить_список_листов()
    Dim aTOC As Variant
    aTOC = Get_TOC_array(ActiveSheet)
    If IsEmpty(aTOC) Then Exit Sub
   
    PrintArray aTOC
End Sub

Private Sub PrintArray(aTOC As Variant)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range(SHEET_NAMES_RANGE).Resize(Range(SHEET_NAMES_RANGE).CurrentRegion.Rows.Count, 1).ClearContents
    Range(SHEET_NAMES_RANGE).Resize(UBound(aTOC, 1), UBound(aTOC, 2)).Value = aTOC
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
   
Private Function Get_TOC_array(sh As Worksheet) As Variant
    Dim arr As Variant, ya As Long
    ReDim arr(1 To sh.Parent.Worksheets.Count - 1)
    Dim curSh As Worksheet
    For Each curSh In sh.Parent.Worksheets
        If curSh.Name <> sh.Name Then
            ya = ya + 1
            arr(ya) = curSh.Name
        End If
    Next
    If ya > 0 Then Get_TOC_array = GetTwoDimArray(arr, ya)
End Function
   
Private Function GetTwoDimArray(arr, ya) As Variant
    Dim brr As Variant
    ReDim brr(1 To ya, 1 To 1)
    For ya = 1 To UBound(brr, 1)
        brr(ya, 1) = arr(ya)
    Next
    GetTwoDimArray = brr
End Function
   
Sub Обновить_имена_листов()
    Range(SHEET_NAMES_RANGE).Value = Range(SHEET_NAMES_RANGE).Value
End Sub   

 Фал переименовывает имена листов и в ярлыке листа и в листе Итог. Меня не устраивает к-во листов, там только 13, а мне надо 18. Если просто добавляю листы код выдаёт ошибку. Код интеллекта добавление листов принимает на ура, но добавленные листы переименовывает только через ярлык листа, через лист Итог(в первом файле, что ч прислал это лист 13) не переименовывает и ещё та проблема в том, что если я добавляю листы и перемещаю лист Итог правее  добавленных листов результат переименования появляется не в листе Итог, а в 13-ом по счету листе .Под словом интеллект я понимаю искусственный интеллект. После переделывания кода из Excel интеллект написал вот это

 Что поменялось и почему:

Option VBASupport 1 убран — код теперь идёт напрямую через UNO API (ThisComponent), а не через слой VBA-совместимости.
Application.EnableEvents/ScreenUpdating → ThisComponent.lockControllers() / unlockControllers() (в Calc нет отдельного EnableEvents, у листов нет built-in модулей Worksheet_Change, как в Excel).
ActiveSheet → ThisComponent.CurrentController.ActiveSheet.
sh.Parent.Worksheets → ThisComponent.Sheets.
Range(...).CurrentRegion → oSheet.createCursorByRange(...).collapseToCurrentRegion() — это реальный метод XSheetCellCursor, аналог Excel'овского CurrentRegion.
Range.Value = Range.Value (в Excel — способ превратить формулу в статичное значение) → построчный setString(getString()).
Первый фрагмент (SheetName) вообще не требовал переделки под синтаксис — я просто оформил его как полноценную Function, чтобы им можно было пользоваться и как макросом, и как функцией в формуле листа (=SheetName(1)).
Куда вставлять: Tools → Macros → Edit Macros, в модуль своего документа (Basic IDE), это не VBA-модуль, а обычный модуль Calc Basic.

Высылаю файлы первый это который был в первом сообщении с именем Итог и второй, что был найден на форуме для Excel.

[sokol92]

Прежде чем обсуждать код любого макроса, нужно обсудить требования к этому макросу: что и как должен делать макрос.

Работа в LibreOffice с файлами формата .xlsx (.xls) в режиме эмуляции макросов Excel не интересна.

В обычном же режиме нет (насколько мне известно) "штатного" события, которое возникает при  переименовании листа пользователем через Меню / Лист / Переименовать лист (или одноименного пункта контекстного меню ярлыка листа). Варианты с UndoManager или с перехватом команды ".uno:RenameTable" сложны и не удобны. См. также обсуждение здесь.

[economist]

Задача у ТС понятна, знакома, топтана холдинговыми тропами вдоль и поперек и нормально, увы, неавтоматизируема.

Поддерживать при коллективной работе элементарный "порядок" в xls/xlsx/m/ods-файле в виде правил "лист Итоги всегда слева" (наверно чтобы использовать 3-х мерные ссылки вида Лист1:Лист12) - это все можно и нужно административными методами. Самый простой из них - создать все нужные листы с правильными именами заранее.

Переименовывать уже занятые сложным контентом листы макросом - опасно, всё будет вылетать и ломаться, независимо от стека и приёмов. А слушать кодом события листов - вдвойне плохо. Это путь который придется бросить рано или поздно.

Вместо обсуждения кривого ИИ-кода, ведущего к глюкам, лучше потратить силы на оргмеры. Да, они не всесильны при слабом руководстве или дружном саботаже. И вот здесь как раз есть способы. Например, забить на правила в основном файле и вынести логику контроля в Python/Pandas, собирая им заново новый ODS-файл. В нем листы будут названы и упорядочены правильно. Вот тут ИИ-код будет гарантированно рабочим, потому что в 10-ти строках кода ошибиться невозможно. Также стоит помнить что есть пяток технологий по отражению данных из таблиц в одном ODS (связи формул или связи с TXT/CSV-файлом, содержащим формулы и валидацию/контракт данных, DDE-связи, DataArray, DataBaseRange), которые десятилетиями связно и непротиворечиво работают в большом проде.

[bigor]

вариант аналогичный по работе файлу для excel на планете.

[bsi]

bigor, огромное спасибо за присланный файл. То что надо! Всех Вам благ.