Список всех листов на отдельном листе

[Robin Gud 17]

Доброго времени суток, уважаемые.
Нужна ваша помощь.
    На этом сайте, в этой ветке https://forumooo.ru/index.php?topic=6956.0 , как раз почти то, что мне нужно. Тот макрос собирает названия всех листов на отдельном листе "Содержание". Но есть один очень неприятный минус. Я на листе "Содержание" в столбцах справа делаю заметки на против каждого названия-ссылки, и заливаю их разным цветом. И если со временем создавать новые листы между уже существующими, а потом опять применить макрос, чтобы он добалил новые листы в этот список, то заметки уже не совпадают с теми листами, напротив которых они создавались. Очень прощу решить эту задачку.  Я в макросах не разбираюсь от слова совсем. Но пару мыслей хотелось бы высказать: может можно как-то сделать так, чтоб при добавлении в список нового названия листа, макрос перед этим выпонял команды "Добавить строчку ниже" в том месте списка, куда он думает прописывать новый лист, потом выделял эту только что добавленную строчку, назначал ей цвет фона "Без заливки", и уже теперь в эту строчку вносил название новаго листа.
    И маленькая просьба: в той ветке форума написали интересную строчку для макроса, которая добавляет возможность с любого листа перейти на лист "Содержание":
  добавь эту строчку  в цикл и будет ссылка на "Содержание" в а1 на всех листах
ThisComponent.Sheets.getByName("" & array1(i) &"").getCellByPosition(0, 0).setformula("=HYPERLINK(""#Содержание"";""Содержание"")")    . Но я понятия не имею, куда её добавлять.
    Очень нужна ваша помощь!
    Спасибо.

[bigor]

Robin Gud 17
Вот макрос с добавлением ссылки на содержание

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

sub Contents
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = ThisComponent.Sheets.getByName("Содержание")
array1()=ThisComponent.sheets().getElementNames()
For i = LBound(array1(),1) to UBound(array1(),1)
oSpreadsheet.getCellByPosition(0, i+2).setformula("=HYPERLINK(""#" & array1(i) & """;""" &  array1(i) & """)")
ThisComponent.Sheets.getByName("" & array1(i) &"").getCellByPosition(0, 0).setformula("=HYPERLINK(""#Содержание"";""Содержание"")")

Next i
End SubС первым вопросом сложнее, макрос получает массив имен имеющихся в книге листов, и на этом этапе отследить новые не получится. Как вариант сравнивать этот массив с имеющимся оглавлением и дописывать только новые.

[Drovosek]

Спасибо, дорогой.

Я тут немного пообщался с chatGPT. Он мне штук 10 макросов навыдавал, но вот только не один не заработал. Постоянно выскакивает какие-то ошибки. Вот что он мне продложил в одном из последних вариантов(тоже не работает):

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

Sub List_of_sheets()
    Dim oSummarySheet As Object
    Dim oDoc As Object
    Dim array1() As String
    Dim i As Integer
    Dim lastRow As Integer
    Dim sheetExists As Boolean
   
    ' Получаем объект документа
    oDoc = ThisComponent
   
    ' Получаем лист "Содержание" или создаем его, если не существует
    sheetExists = False
    For i = 0 To oDoc.Sheets.getCount() - 1
        If oDoc.Sheets.getByIndex(i).getName() = "Содержание" Then
            sheetExists = True
            Exit For
        End If
    Next i
   
    If Not sheetExists Then
        oSummarySheet = oDoc.Sheets.insertNewByName("Содержание", oDoc.Sheets.getCount())
        oSummarySheet.getCellByPosition(0, 0).String = "Названия листов:"
        lastRow = 0
    Else
        oSummarySheet = oDoc.Sheets.getByName("Содержание")
        lastRow = oSummarySheet.Rows.Count - 1
    End If
   
    ' Получаем имена всех листов в документе
    array1 = oDoc.Sheets.getElementNames()
   
    ' Для каждого листа создаем гиперссылки и записываем название листа
    For i = LBound(array1) To UBound(array1)
        ' Проверяем, нужно ли добавить новую строку
        If i > lastRow Then
            oSummarySheet.Rows.insertByIndex(lastRow + 1, 1)
            lastRow = lastRow + 1
        End If
        ' Создаем гиперссылку на лист
        oSummarySheet.getCellByPosition(0, i).setFormula("=HYPERLINK(""#" & array1(i) & """;""" & array1(i) & """)")
        ' Создаем гиперссылку на "Содержание" на каждом листе
        oDoc.Sheets.getByName(array1(i)).getCellByPosition(0, 0).setFormula("=HYPERLINK(""#Содержание"";""Содержание"")")
        ' Записываем название листа
        oSummarySheet.getCellByPosition(1, i).String = array1(i)
    Next i
   
    ' Автонастройка ширины столбцов
    oSummarySheet.Columns(0).OptimalWidth = True
    oSummarySheet.Columns(1).OptimalWidth = True
   
    MsgBox "Таблица содержания успешно обновлена.", vbInformation
End Sub

Может разбирающиеся в этой абракабре люди посмотрят  и из этого скрипта можно что-то почерпнуть.

[bigor]

Нет там ничего интересного, скорее всего неверно была поставлена задача. Нужно найти не сколько ячеек нужно добавить, а выбрать из полученного массива имена листов, которых нет в старом содержании и добавлять их.

[Drovosek]

Спасибо за ответ.
Пойду ещё немного поборюсь с chatGPT.

[sokol92]

Я на листе "Содержание" в столбцах справа делаю заметки на против каждого названия-ссылки, и заливаю их разным цветом.

Выложите, пожалуйста, файл-пример для тестирования возможных решений.

[Drovosek]

Хотелось бы, чтобы при добавлении новых имён в список "Содержание", уже сделанные заметки к старым именам в этом списке в колонках справа, не перепутывались.  Но пока что это не получается. Новое имя сдвигает старые имена на одну строчку вниз, а заметки к старым именам остаются на месте. Вот если бы в примере при добавлении имени листа "ручки-тип2" макрос в листе "Содержание" вставлял пустую строчку между "ручки-тип1" и "ручки-тип3" было бы супер.    Немного поигрался с ChatGPT и один макрос от него сохранил в документе. Он вроде бы и работает, но это всё равно не то.

[economist]

Тут надо не с ChatGPT общаться, а принять волевое и архитектурно правильное решение, которое будет работать с уже написанными макросами:

- никаких правок на листе с оглавлением,  лист переформируется автоматом заново, при открытии книги

- листам-исключениям дать суффикс, чтобы  они не попали в О.

- порядок листов равен порядку О.

- комментарии для О. пишем на листах в любой ячейке с именем КомментОгл, откуда их легко берет макрос и дописывает куда надо. Цвета, если есть система, так же задаются в ней.

И сразу все простое станет сложным и решится за пару часов.

[sokol92]

откуда их легко берет макрос

Проще создать временный лист с копией листа "Содержание" и с этого листа брать заметки к листу. После успешного завершения макроса временный лист удалить.

Кстати, если судить по тексту макросов, GPT еще недостаточно знает отличия LO Basic от Excel VBA. 

[Drovosek]

Спасибо всем, дорогие форумчане, за ваше участие в решении этой задачи.
Я всё на сегодня, - бо голова уже не варит. Может завтра на свежую голову что-то да получиться.

[economist]

Где правильнее держать заметки к Листу для Оглавления? Зависит от контекста, в котором удобно их вводить (где, что и как). Внезапно часто оказывается что красную дописку "(в процессе)", ну чтобы вот так:

3. Расчет цены (в процессе)
4. Расчет себестоимости (готов)

бывает проще всего организовать Формулой на листе, которая будет считать число пустых желтых (подлежащих заполнению) ячеек и выводить слово (в процессе) или (готово).

Красный цвет заливки яч. удобно сделать буквой в той же формуле (и ее легко поменять, обесцветить, сделать менее кислотной гамму итд):

"в процессе R" -> "в процессе" + vbRed
"готово G"  -> "готово" + vbGreen

Саму подсветку, если вспомнить что разрабы OpenOffice|LibreOffice потратили уйму часов на совместимость с VBA, проще сделать на нем, используя прекрасный ясный синтаксис для заливки ячейки, который можно подглядеть ну где угодно (на форумах фанатов Excel):

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

option vbasupport 1

Sub Main
[B3].interior.color = vbRed
[B3].font.color = vbYellow
End Sub 

Просто перепишите это как Функцию в отдельный Module2 с vbasupport 1 и получайте столбец в Оглавлении с цветными статусами полностью автоматически.

Но для того чтобы сделать это раз и пользоваться всегда, в разных файлах - нужна "Система" (набор соглашений с самим собой), которую кроме вас никто не продумает лучше. А ChatGPT - это тот, кто постоянно будет ломать вам вашу систему, навязывать "отрывки из обрывков", до тех пор пока вы сами не станете круто дополнять prompt-ы контекстом (но это сложнее чем писать макросы).

[Drovosek]

Привет Народ!  После долгого общения с ChatGPT воткакой макрос он мне выдал в итоге:

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

Sub gpt()
    Dim oDoc As Object
    Dim oSheets As Object
    Dim oSummarySheet As Object
    Dim array1() As String
    Dim i As Integer
    Dim targetSheetName As String
   
    ' Получаем доступ к текущему документу
    oDoc = ThisComponent
   
    ' Получаем коллекцию листов
    oSheets = oDoc.Sheets
   
    ' Получаем лист "  Список"
    targetSheetName = "  Список"  ' Название листа с двумя пробелами
    On Error Resume Next
    oSummarySheet = oSheets.getByName(targetSheetName)
    On Error GoTo 0
   
    ' Если лист "  Список" не найден, создаем новый
    If oSummarySheet Is Nothing Then
        oSummarySheet = oDoc.Sheets.insertNewByName(targetSheetName, oDoc.Sheets.Count)
    End If
   
    ' Очищаем данные на листе "  Список"
    oSummarySheet.clearContents(com.sun.star.sheet.CellFlags.VALUE)
   
    ' Получаем массив имен листов
    array1() = oSheets.getElementNames()
   
    ' Создаем список имён всех листов, исключая первые 4 листа, с гиперссылками на свои листы
    Dim rowCounter As Integer
    rowCounter = 2 ' Начинаем с третьей строки
   
    For i = 4 To UBound(array1)
        ' Получаем имя текущего листа
        Dim sheetName As String
        sheetName = array1(i)
       
        ' Получаем ячейку в текущей строке листа "  Список"
        Dim targetCell As Object
        targetCell = oSummarySheet.getCellByPosition(0, rowCounter)
       
        ' Записываем имя листа в ячейку с гиперссылкой
        targetCell.setFormula("=HYPERLINK(""#" & sheetName & """;""" & sheetName & """)")
       
        ' Копируем значения ячеек I3:N3 с текущего листа и вставляем их в столбцы B-G на листе "  Список"
        For j = 0 To 5
            ' Получаем значение и цвет заливки ячейки с текущего листа
            Dim cellValue As String
            Dim cellColor As Long
            Dim sourceCell As Object
            Set sourceCell = oSheets.getByName(sheetName).getCellByPosition(8 + j, 2)
            cellValue = sourceCell.getString()
            cellColor = sourceCell.CellBackColor
           
            ' Получаем целевую ячейку на листе "  Список"
            Set targetCell = oSummarySheet.getCellByPosition(j + 1, rowCounter)
           
            ' Записываем значение в ячейку на листе "  Список"
            targetCell.setString(cellValue)
           
            ' Задаем цвет заливки ячейки на листе "  Список"
            targetCell.CellBackColor = cellColor
        Next j
       
        ' Увеличиваем счетчик строки
        rowCounter = rowCounter + 1
    Next i
End Sub

Конечно, тут логика действий уже другая. Теперь макрос берёт данные с конкретных ячеек с каждого листа (кроме первых 4), и уже ними дополняет лист "  Список". И, в общем-то, он даже работает, но есть 1 неприятный минус: он на листе "  Список" не удаляет в конце списка имён те листы, которых в книге уже нет. В начале списка и в середине - всё чётко - строку с именем и данными удалёного листа макрос удаляет. Даже просил GPT в начале работы макроса полностью очищать лист "  Список" от данных (кроме первых двух строк), он предлагал много разных вариантов кода, но не помогло.    Опять нужна ваша помощь. Может кто может немного доработать макрос?    А вот макрос, предложенный BIGOR отлично работает со списком имён (и добавляет новые, и удаляет имена удалённых листов), но как прикрутить к нему копирование данных определённых ячеек (и их цвет) я не в курсе.

Robin Gud 17
Вот макрос с добавлением ссылки на содержание

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

sub Contents
oSelection = ThisComponent.getCurrentSelection()
oSpreadsheet = ThisComponent.Sheets.getByName("Содержание")
array1()=ThisComponent.sheets().getElementNames()
For i = LBound(array1(),1) to UBound(array1(),1)
oSpreadsheet.getCellByPosition(0, i+2).setformula("=HYPERLINK(""#" & array1(i) & """;""" &  array1(i) & """)")
ThisComponent.Sheets.getByName("" & array1(i) &"").getCellByPosition(0, 0).setformula("=HYPERLINK(""#Содержание"";""Содержание"")")

Next i
End SubС первым вопросом сложнее, макрос получает массив имен имеющихся в книге листов, и на этом этапе отследить новые не получится. Как вариант сравнивать этот массив с имеющимся оглавлением и дописывать только новые.

Очень нужна ваша помощь.

[economist]

Даже просил GPT в начале работы макроса полностью очищать лист "  Список" от данных (кроме первых двух строк), он предлагал много разных вариантов кода, но не помогло.

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

option vbasupport 1

Sub Main
    Sheets("Содержание").[3:1048576].clearcontents
    Sheets("Содержание").[3:1048576].clearformats
    Sheets("Содержание").[3:1048576].clearcomments

' дальше ваш код

End Sub

[bigor]

Не смотрел что там ИИ насочинял, понял, только что нужно i3:n3 переносить на лист содержание
Если лист содержания всегда первый, то можно такой вариант попробовать. Иначе нужно придумывать исключения, как @economist писал выше

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

sub Contents
    oSelection = ThisComponent.getCurrentSelection()   
    oSpreadsheet = ThisComponent.Sheets.getByName("Содержание")
    array1()=ThisComponent.sheets().getElementNames()
    For i = LBound(array1(),1)+1 to UBound(array1(),1)
    Arr=ThisComponent.sheets(i).getCellRangeByName("i3:n3").getDataArray()
    oSpreadsheet.getCellByPosition(0, i+2).setformula("=HYPERLINK(""#" & array1(i) & """;""" &  array1(i) & """)")   
    oSpreadsheet.getCellRangeByPosition(3, i+2,8, i+2).setDataArray(Arr)
    ThisComponent.Sheets.getByName("" & array1(i) &"").getCellByPosition(0, 0).setformula("=HYPERLINK(""#Содержание"";""Содержание"")")
   
    Next i
End Sub
очистку забыл
вставить перед For    

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

oSpreadsheet.getCellRangeByName("A3:n100").clearContents(23)

[Drovosek]

Доброго времени суток, уважаемые.
Большое вам спасибо за помощь, советы и код.
Поработал ещё немного с GPT и вот какой макрос получилось слепить  :

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

Sub spisok_listov()
    Dim oSheet As Object
    Dim oRange As Object
    Dim oDispatcher As Object
    Dim oDocument As Object
   
    ' Получаем доступ к текущему документу и его диспетчеру
    oDocument = ThisComponent.CurrentController.Frame
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
   
    ' Выбираем лист "  Список"
    oSheet = ThisComponent.Sheets.getByName("  Список")
   
    ' Выбираем все ячейки на листе "  Список", кроме первых двух строк
    oRange = oSheet.getCellRangeByName("A3:IV1048576")
   
    ' Удаляем содержимое ячеек на листе "  Список"
    oRange.clearContents(1023)

Dim oDoc As Object
    Dim oSheets As Object
    Dim oSummarySheet As Object
    Dim array1() As String
    Dim i As Integer
    Dim targetSheetName As String
   
    ' Получаем доступ к текущему документу
    oDoc = ThisComponent
   
    ' Получаем коллекцию листов
    oSheets = oDoc.Sheets
   
    ' Получаем лист "  Список"
    targetSheetName = "  Список"  ' Название листа с двумя пробелами
    On Error Resume Next
    oSummarySheet = oSheets.getByName(targetSheetName)
    On Error GoTo 0
   
    ' Если лист "  Список" не найден, создаем новый
    If oSummarySheet Is Nothing Then
        oSummarySheet = oDoc.Sheets.insertNewByName(targetSheetName, oDoc.Sheets.Count)
    End If
   
    ' Очищаем данные на листе "  Список"
    oSummarySheet.clearContents(com.sun.star.sheet.CellFlags.VALUE)
   
    ' Получаем массив имен листов
    array1() = oSheets.getElementNames()
   
    ' Создаем список имён всех листов, исключая первые 4 листа, с гиперссылками на свои листы
    Dim rowCounter As Integer
    rowCounter = 2 ' Начинаем с третьей строки
   
    For i = 4 To UBound(array1)
        ' Получаем имя текущего листа
        Dim sheetName As String
        sheetName = array1(i)
       
        ' Получаем ячейку в текущей строке листа "  Список"
        Dim targetCell As Object
        targetCell = oSummarySheet.getCellByPosition(0, rowCounter)
       
        ' Записываем имя листа в ячейку с гиперссылкой
        targetCell.setFormula("=HYPERLINK(""#" & sheetName & """;""" & sheetName & """)")
       
        ' Копируем значения ячеек I3:N3 с текущего листа и вставляем их в столбцы B-G на листе "  Список"
        For j = 0 To 5
            ' Получаем значение и цвет заливки ячейки с текущего листа
            Dim cellValue As String
            Dim cellColor As Long
            Dim sourceCell As Object
            Set sourceCell = oSheets.getByName(sheetName).getCellByPosition(8 + j, 2)
            cellValue = sourceCell.getString()
            cellColor = sourceCell.CellBackColor
           
            ' Получаем целевую ячейку на листе "  Список"
            Set targetCell = oSummarySheet.getCellByPosition(j + 1, rowCounter)
           
            ' Записываем значение в ячейку на листе "  Список"
            targetCell.setString(cellValue)
           
            ' Задаем цвет заливки ячейки на листе "  Список"
            targetCell.CellBackColor = cellColor
        Next j
       
        ' Увеличиваем счетчик строки
        rowCounter = rowCounter + 1
    Next i
    ' Выводим сообщение "ГОТОВО"
    MsgBox "                   ГОТОВО" & Chr(13) & "Макрос выполнен успешно" & Chr(13) & "            Хорошего дня!"
End Sub


Макрос рабочий и полностью делает то, что мне нужно. Возможно, всё тут работает через костыли, но ведь работает.
  Ещё раз спасибо!