Сохранение без форматирования

[mikekaganski]

- нумерация страниц зависла - одна и та же цифра по всему документу.

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

[RageGuy]

Ну а чего же Вы хотите.

Просто для меня это неочевидно. Но это ерунда, нумерация лечиться на раз.
Нашел причину глюка - видимо сохраненные изменения вносили свою лепту. Принял все изменения. После этого макрос сделал все правильно и на удивление гораздо быстрей, чем раньше. Удаленного текста больше не наблюдается. Сплошной восторг Осталось нумерацию победить.

[RageGuy]

А с нумерацией я разобрался. Решить, не решил. Но почему не работала, вроде разобрался.
1. Я не сразу понял, что он работает снизу вверх. То есть надо поставить курсор в самом низу списка, и макрос начинает оттуда заменять нумерацию;
2. Если по пути встречается абзац без нумерации, то макрос останавливается;
3. Если в нумерации не цифры, а маркеры, то  ничего взамен не ставиться, а маркер удаляется.
4. Если в стиле абзаца в разделе "структура и нумерация" выбран стиль нумерации, то макрос после удаления нумерации добавляет ее по-новой.
mikekaganski, Вы не поможете с пунктами № 2 и 3? (если я совсем обнаглел, то уж прям так и скажите )

[mikekaganski]

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

Sub ConvertNumberedListToLabels
    oSel = ThisComponent.getCurrentController.getSelection()
    oSelEnd = oSel.getByIndex(0).getEnd()
    oCurs = ThisComponent.getText().createTextCursorByRange(oSelEnd)
    oCurs.gotoStartOfParagraph(False)
    Do
      If oCurs.NumberingIsNumber Then
        labelString = oCurs.ListLabelString
        oCurs.getText().insertString(oCurs, labelString & " ", False)
        While Not IsEmpty(oCurs.NumberingRules)
          oCurs.NumberingRules = None
        Wend
      End If
    Loop While oCurs.gotoPreviousParagraph(False)
End Sub

[RageGuy]

Класс! Работает, чертяга!
В свое время (лет 15 назад) пытался разобраться в "макросонаписании", что-то не пошло. Я сейчас жалею.
Я не думал, что Вы так быстро отреагируете на мое последнее сообщение, а я его поправил . В этом макросе же только о цифровой нумерации речь идет? Если маркер в нумерации - это уже другая история?

[mikekaganski]

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

Function GetNumberingLevelProperty(oCurs As Object, propName As String)
  nt = oCurs.NumberingRules.getByIndex(oCurs.NumberingLevel)
  For i = LBound(nt) To UBound(nt)
    If nt(i).Name = propName Then
      GetNumberingLevelProperty = nt(i).Value
      Exit Function
    End If
  Next i
End Function

Sub ConvertNumberedListToLabels
  oSel = ThisComponent.getCurrentController.getSelection()
  oSelEnd = oSel.getByIndex(0).getEnd()
  oCurs = ThisComponent.getText().createTextCursorByRange(oSelEnd)
  oCurs.gotoStartOfParagraph(False)
  Do
    If oCurs.NumberingIsNumber Then
      numType = GetNumberingLevelProperty(oCurs, "NumberingType")
      If numType = com.sun.star.style.NumberingType.CHAR_SPECIAL Then
        labelString = GetNumberingLevelProperty(oCurs, "BulletChar")
      Else
        labelString = oCurs.ListLabelString
      End If
      oCurs.getText().insertString(oCurs, labelString & " ", False)
      While Not IsEmpty(oCurs.NumberingRules)
        oCurs.NumberingRules = Empty
      Wend
    End If
  Loop While oCurs.gotoPreviousParagraph(False)
End Sub

Считывание уровня специально вынесено в отдельную функцию с получением массива там (как бы неоптимально), во избежание проблем с уничтожением объекта NumberingRules при присвоении Empty.

[RageGuy]

Да, отлично. Маркированные списки обрабатывает.
К сожалению, не получается оттестировать полноценно за раз, каждый раз всплывает что-то новенькое. Сейчас обнаружил что макрос не обрабатывает нумерацию в таблицах. Я так понял, что макрос таблицы и не учитывает.

[mikekaganski]

Да. Вы проигнорировали то, что я описал в ответе #17. Я уже сделал - специально по Вашему запросу - функцию в том виде, чтобы обрабатывать и таблицы, и маркеры, и отступы (насколько получается) ... это будет встроено в программу. А Вы просите допиливать простенький макрос. Да, возможно. Но повторять уже сделанную работу на другом языке времени жалко.

[RageGuy]

Да. Вы проигнорировали то, что я описал в ответе #17.

Да нет, не игнорировал. Я его, если честно, не до конца понял. Я вообще решил, что выявленные проблемы по новой реализации. А сейчас носом ткнули, перечитал пост, все встало все на свои места.

Я уже сделал - специально по Вашему запросу... это будет встроено в программу

А, так Вы разработчик, только сейчас дошло. В какой версии ожидать данный функционал?

Но повторять уже сделанную работу на другом языке времени жалко

Вы и так много для меня сделали. Спасибо большое! Извините, если показался навязчивым.

[mikekaganski]

Будет в 7.1 - и тогда заработают макросы типа

[RageGuy]

Понял, спасибо

[mikekaganski]

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


Function GetNumberingLevelProperty(par As Object, propName As String)
  nt = par.NumberingRules.getByIndex(par.NumberingLevel)
  For i = LBound(nt) To UBound(nt)
    If nt(i).Name = propName Then
      GetNumberingLevelProperty = nt(i).Value
      Exit Function
    End If
  Next i
End Function

Function addParagraphsToList(a As Object, list() As Object)
  If a.supportsService("com.sun.star.text.Paragraph") Then
    ReDim Preserve list(LBound(list) To UBound(list) + 1)
    list(UBound(list)) = a   
  ElseIf a.supportsService("com.sun.star.text.TextTable") Then
    cells = a.getCellNames()
    For i = LBound(cells) To UBound(cells)
      list = addParagraphsToList(a.getCellByName(cells(i)), list)
    Next i
  ElseIf a.supportsService("com.sun.star.text.TextRanges") Then
    For i = 0 To a.Count - 1
      list = addParagraphsToList(a.getByIndex(i), list)
    Next i
  ElseIf a.supportsService("com.sun.star.text.TextRange") Then
    list = addParagraphsToList(a.Text, list)
  ElseIf HasUnoInterfaces(a, "com.sun.star.container.XEnumerationAccess") Then
    aEnum = a.createEnumeration
    While aEnum.hasMoreElements
      list = addParagraphsToList(aEnum.nextElement, list)
    Wend
  End If
  addParagraphsToList = list
End Function

Function convertTableSelectionToList(list() As Object)
  ctl = ThisComponent.CurrentController
  rng = ctl.getViewCursor.TextTable.getCellRangeByName(ctl.getSelection.getRangeName)
  data = rng.DataArray
  For i = LBound(data) To UBound(data)
    For j = LBound(data(i)) To UBound(data(i))
      list = addParagraphsToList(rng.getCellByPosition(j, i), list)
    Next j
  Next i
  convertTableSelectionToList = list
End Function

Sub ConvertNumbersToText_Impl
  Dim list() As Object
  sel = ThisComponent.getCurrentController.getSelection
  If sel.supportsService("com.sun.star.text.TextTableCursor") Then
    list = convertTableSelectionToList(list)
  Else
    list = addParagraphsToList(sel, list)
  End If

  For i = UBound(list) To LBound(list) Step -1
    par = list(i)
    If par.NumberingIsNumber Then
      labelString = par.ListLabelString
      followedBy = GetNumberingLevelProperty(par, "LabelFollowedBy")
      Select Case followedBy
        Case 0 ' SvxNumberFormat::LabelFollowedBy::LISTTAB
          labelString = labelString & Chr$(9)
        Case 1 ' SvxNumberFormat::LabelFollowedBy::SPACE
          labelString = labelString & " "
        Case 3 ' SvxNumberFormat::LabelFollowedBy::NEWLINE
          labelString = labelString & Chr$(10)
      End Select
      numText = par.getStart
      numText.setString(labelString)

      charStyle = GetNumberingLevelProperty(par, "CharStyleName")
      If Len(charStyle) > 0 Then numText.CharStyleName = charStyle

      numType = GetNumberingLevelProperty(par, "NumberingType")
      If numType = com.sun.star.style.NumberingType.CHAR_SPECIAL Then
        bulletText = numText.getStart
        bulletText.setString(GetNumberingLevelProperty(par, "BulletChar"))
        font = GetNumberingLevelProperty(par, "BulletFont")
        If Not IsEmpty(font) Then
          bulletText.CharFontName = font.Name
          bulletText.CharFontStyleName = font.StyleName
          bulletText.CharFontFamily = font.Family
          bulletText.CharFontCharSet = font.CharSet
          bulletText.CharWeight = font.Weight
          bulletText.CharUnderline = font.Underline
          bulletText.CharStrikeout = font.Strikeout
          bulletText.CharAutoKerning = font.Kerning
          bulletText.CharFontPitch = font.Pitch
          bulletText.CharWordMode = font.WordLineMode
          bulletText.CharRotation = font.Orientation * 10
          If font.Height <> 0 Then bulletText.CharHeight = font.Height
        End If

        color = GetNumberingLevelProperty(par, "BulletColor")
        If Not IsEmpty(color) Then
          If Not (color Is Nothing) Then bulletText.CharColor = color
        End If
      End If

      par.ParaLeftMargin = GetNumberingLevelProperty(par, "IndentAt")
      par.ParaFirstLineIndent = GetNumberingLevelProperty(par, "FirstLineIndent")
      If followedBy = 0 Then ' SvxNumberFormat::LabelFollowedBy::LISTTAB
        stops = par.ParaTabStops
        ReDim Preserve stops(LBound(stops) To UBound(stops) + 1)
        stops(UBound(stops)) = New com.sun.star.style.TabStop
        c = stops(0).FillChar
        With stops(UBound(stops))
          .Position = GetNumberingLevelProperty(par, "ListtabStopPosition")
          .Alignment = 0 ' com.sun.star.style.TabAlign.TabAlign_LEFT
        End With
        par.ParaTabStops = stops
      End If

      While Not IsEmpty(par.NumberingRules)
        par.NumberingRules = Empty
      Wend
    End If
  Next i
End Sub

Sub ConvertNumbersToText
  doc = ThisComponent
  undo = doc.getUndoManager
  undo.enterUndoContext("ConvertNumbersToText")
  doc.lockControllers
  On Error Resume Next
  ConvertNumbersToText_Impl
  doc.unlockControllers
  undo.leaveUndoContext
End Sub


[RageGuy]

Будет в 7.1 - и тогда заработают макросы типа

А когда примерно выйдет эта версия? Нет информации?

[kompilainenn]

А когда примерно выйдет эта версия? Нет информации?

в начале февраля 2021

[RageGuy]

Спасибо