Перевод VBA макроса в ИД

[Onger]

Форматирование предметного указателя (перевод VBA макроса в ИД_

Задача скрипта приведения в порядок номеров страниц в предметном указателя, т.е.
Текст 1, 2, 3, 4, 5, 7, 9, 10 в Текст 1-5, 7, 9-10
Есть VBA макрос который решает эту задачу в Ворде в ИД.
Листинг VBA макроса

Private Sub CorrectPageNum()

If ActiveDocument.Indexes.Count = 0 Then
    MsgBox "Указатель не найден", vbExclamation
    Exit Sub                                                                                       
End If

Dim Ind As Index
Dim IP As Paragraph
Dim FirstChar As String

Set Ind = ActiveDocument.Indexes(1)

Set IndParagraphs = Ind.Range.Paragraphs


CountPar = 1
TotalWork = IndParagraphs.Count
WorkCount = 0        
                            
For Each IP In IndParagraphs
                
                'Progress
                WorkCount = WorkCount + 1
                Percent = Int(100 * WorkCount / (TotalWork + 1) + 0.5)
                If OldPercent <> Percent Then
                    s = WordBasic.MsgBox("Форматирование указателя" + Str(Percent) + "%", MyMacroName_$, -8)
                    OldPercent = Percent
                End If
    
'записывает всю строку
    FullLine = IP.Range.Text
'последний элемент
    EndLine = Right(FullLine, 1)
    FullLine = Left(FullLine, Len(FullLine) - 1)
'проверка на см.    
     XrefPos = InStr(FullLine, ".  см.")
     If XrefPos > 0 Then GoTo NEXTP
    
    pos = 0
'поиск ", "
    s = InStr(FullLine, ", ")
    While s
'читает первый символ
        FirstChar = Mid(FullLine, s + 2, 1)
        If Not (FirstChar Like "#") Then
            s = InStr(s + 1, FullLine, ", ")
        Else
            pos = s
            s = 0
        End If
    Wend
' в диапозоне чисел проверка на См.
    If pos Then
        OldPages = Right(FullLine, Len(FullLine) - pos)
        XrefPos = InStr(OldPages, ",  Cм.")
        If XrefPos = 0 Then
            XrefPos = InStr(OldPages, ",  см.")
        End If
        XRef = ""
        If XrefPos Then
            XRef = Right(OldPages, Len(OldPages) - XrefPos + 1)
            OldPages = Left(OldPages, XrefPos - 1)
        End If

    OldStr = OldPages
    CP = OldStr
    OldStr = OldStr + ", "
    P = InStr(OldStr, ",")
    NewStr = ""
    NumP = -2
    Flag = 0
    While P
        Num = WordBasic.Val(Left(OldStr, P - 1))
'считівает диапозон без 2-х чисел слева      
  OldStr = Right(OldStr, Len(OldStr) - P)
        P = InStr(OldStr, ",")
        If Num = NumP + 1 Then
            If Flag = 0 Then NewStr = NewStr + Chr(30)
            Flag = 1
        ElseIf Flag Then
            NewStr = NewStr + LTrim(Str(NumP)) + "," + Str(Num)
            Flag = 0
        ElseIf NewStr = "" Then
            NewStr = Str(Num)
        Else
            NewStr = NewStr + "," + Str(Num)
        End If
        NumP = Num
    Wend
    If Flag Then NewStr = NewStr + LTrim(Str(NumP))
            CP = Right(NewStr, Len(NewStr) - 1)
            NewPages = CP
            NoBreakSpace = " "
            Set Stp = IP.Range.Style
            Set R = IP.Range
            R.End = R.End - 1
            R.Delete
            R.InsertBefore Left(FullLine, pos - 1) + "," + String(1, NoBreakSpace) + NewPages + XRef ' + EndLine
            'IP.Previous.Range.Style = Stp
    End If
NEXTP:
'    CountPar = CountPar + 1
Next IP
'Wend
End Sub

 

[Oleg Butrin]

Ответ: Форматирование предметного указателя (перевод VBA макроса в ИД_

Как-то писал по просьбе ув. Батушева функцию для преобразования ряда чисел в правильные диапазоны. Было как-то проще, чем описаный здесь метод. Поищу - выложу. Или Батушев выложит, если у него под рукой.

 

[Onger]

Ответ: Форматирование предметного указателя (перевод VBA макроса в ИД_

Олег, спасибо за отклик буду очень признателен, а у Виталия я уже спрашивал, пока не ответил.

 

[Oleg Butrin]

Ответ: Перевод VBA макроса в ИД

function getIntervals (myArray) {
     var myElement = myArray[0];
     var myCurElement = myArray[0];
     var myResult = new Array(String(myElement));
     var myCount = 0;
     for (myCounter = 0; myCounter < myArray.length; myCounter++) {
          if ((myArray[myCounter] - myCurElement) == 1) {
               myResult[myCount] = String(myElement) + "-" + String(myArray[myCounter]);
               myCurElement = myArray[myCounter];
          }
          if ((myArray[myCounter] - myCurElement) > 1) {
               myElement = myArray[myCounter];
               myCurElement = myElement;
               myCount++;
               myResult[myCount] = String(myElement);
          }
     }
     return myResult;
}

В общем, функция получает массив чисел и выдает интервалы.


Не по теме:
Храните историю ICQ - зело полезная вещь. Вот у нас с Батушевым 32 000 сообщений на двоих. Чего там только нет, если хорошо поискать.

 

[vbatushev]

Ответ: Перевод VBA макроса в ИД

у Виталия я уже спрашивал, пока не ответил

Прошу прощения, состояние такое, что если сразу не сделаю, не помню ничерта

 

[Onger]

Ответ: Перевод VBA макроса в ИД

Олег и Виталий огромное вам спасибо