Макрос: определение номера текущей страницы

Комментариев: 10

1. 

   Тамара
   10.09.2009 в 16:15 | #1

   Подскажите, как можно реализовать следующую задачу:

   В документе необходимо выделить определенный текст, который встречается 1 раз на одной странице. Затем определить номера страниц на которых находиться данный выделенный текст (нумерация с 1 страницы)и задать их на печать
2. 

   Александр Витер
   10.09.2009 в 17:45 | #2

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

   Sub PrintOnlyPagesWithFoundText()
     Dim sText As String 'Текст, который нужно найти
     Dim sPagesToPrint As String 'Список страниц, которые нужно напечатать
     Dim nPrevPageNum As Integer 'Номер предыдущей найденной страницы
     
     sText = "состав" 'Задаем строку поиска
     
     With ActiveDocument.Range.Find
       .Text = sText
       While .Execute 'Если строка найдена
         'Если номер предыдущей страницы, на которой был найден текст
         'не равен номер текущей страницы, то изменяем его
         If nPrevPageNum  ActiveDocument.Range(0, .Parent.End).ComputeStatistics(wdStatisticPages) Then
           nPrevPageNum = ActiveDocument.Range(0, .Parent.End).ComputeStatistics(wdStatisticPages)
           'Добавляем запятую в конец строки, если она не пустая
           If Len(sPagesToPrint) > 0 Then sPagesToPrint = sPagesToPrint & ","
           'дописываем номер страницы в список
           sPagesToPrint = sPagesToPrint & CStr(nPrevPageNum)
         End If
       Wend
     End With
     
     'Если строка с номерами страниц не пустая, то выводим на печать отобраные страницы
     If Len(sPagesToPrint) > 0 Then _
       ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:=sPagesToPrint
   End Sub
3. 

   Тамара
   11.09.2009 в 13:14 | #3

   Спасибо большое

   А возможно ли полученный список отсортировать по алфавиту и таким образом выдать на печать. Дело в том что есть искомый текст "1" и где соответствует выдает на печать, но если есть искомый текст "2" и "3" то эти страницы нужно выдать на печать повторно таким образом чтобы 1 копия шла за другой. Т.е. если стандартно выдать на печать страницы 1,3,3 то выдаст страницу 3 - 2 раза подряд. Макрос выше я изменила чтобы такие страницы выводились повторно, но не выводит страницы по порядку. Попыталась использовать макрос, который выложен на этом сайте "Сортировка строки по алфавиту", но там идет не соответствие типов, как и ожидалось и как изменить этот момент, в голову не приходит
4. 

   Александр Витер
   11.09.2009 в 13:33 | #4

   Тамара, попытайтесь сформулировать понятнее. При чем здесь сортировка по алфавиту?
5. 

   Тамара
   11.09.2009 в 13:49 | #5

   Скажем так, допустим выполняется процедура PrintOnlyPagesWithFoundText. И когда начинаеться поиск текста, заполняется sPagesToPrint. То как я изменила процедуру в н.м. список может быть заполнен следующим образом:

   1,3,4,5,6,1,4,

   и нужно привести его к виду

   1,1,3,4,4,5,6,
6. 

   Тамара
   11.09.2009 в 13:53 | #6

   Вобщем необходимо чтобы листы выдавались на печать именно в последовательности 1,1,3,4,4,5,6, а не 1,3,4,5,6,1,4,

   Конечно возможно есть более просто способ, но познания в этом у меня не большие
7. 

   Александр Витер
   13.09.2009 в 08:31 | #7

   Что ж, ничего лучшего, чем сортировка, тут, видимо, не придумаешь.

   Я предлагаю свою функцию, которая будет сортировать вашу строку по возрастанию:

   'Функция сортировки строки по возрастанию
   Function GetSortedString(sSrcStr As String) As String
     
     Dim arStr 'Вспомогательный строковый массив
     Dim arDbl() As Double 'Вспомогательный массив чисел
     Dim i As Integer
     
     'Преобразуем строку, разделенную запятыми, в массив строк
     arStr = Split(sSrcStr, ",")
     ReDim arDbl(UBound(arStr)) 'Определяем размер массива для чисел
     
     'Переписываем значение из строкового массива в массив чисел с преобразованием из строки в число
     For i = 0 To UBound(arStr)
       arDbl(i) = CDbl(arStr(i))
     Next i
       
     'Сортируем массив по возрастанию
     BinaryInsertionSort arDbl(), UBound(arDbl) + 1
     
     'Переписываем значения из числового массива в строковый с преобразованием из числа в строку
     For i = 0 To UBound(arStr)
       arStr(i) = CStr(arDbl(i))
     Next i
     'Пребразуем массив в строку, разделенную запятыми
     GetSortedString = Join(arStr, ",")
   End Function
   'Процедура сортировки массива по возрастанию методом бинарного деления
   Sub BinaryInsertionSort(ByRef Arr() As Double, ByVal N As Long)
     Dim B As Long
     Dim C As Long
     Dim E As Long
     Dim i As Long
     Dim J As Long
     Dim K As Long
     Dim Tmp As Double
     
     For i = 2# To N Step 1
       B = 1#
       E = i - 1#
       C = (B + E) \ 2#
       Do While B  C
         If Arr(C - 1#) > Arr(i - 1#) Then
           E = C
         Else
           B = C
         End If
         C = (B + E) \ 2#
       Loop
       If Arr(B - 1#) < Arr(i - 1#) Then
         If Arr(i - 1#) > Arr(E - 1#) Then
           B = E + 1#
         Else
           B = E
         End If
       End If
       K = i
       Tmp = Arr(i - 1#)
       Do While K > B
         Arr(K - 1#) = Arr(K - 1# - 1#)
         K = K - 1#
       Loop
       Arr(B - 1#) = Tmp
     Next i
   End Sub

   Вставьте эти функции в один модуль с макросом, а в самом макросе, непосредственно перед печатью, поместите вызов

   'Сортируем числа в строке по возрастанию с помощью специальной функции
     sPagesToPrint = GetSortedString(sPagesToPrint)

   Сразу скажу, что процедура сортировки методом бинарного деления придумана не мной, а взята готовой с этого сайта: http://alglib.sources.ru/sorting/bininssort.php

   Успехов!
8. 

   Тамара
   15.09.2009 в 11:55 | #8

   Указывает на ошибку при обработке строки

   GetSortedString = Join(arDbl, ",")

   пишет ошибка при вызове процедуры либо аргумента
9. 

   Александр Витер
   15.09.2009 в 12:13 | #9

   Правильно, нужно заменить arDbl на arStr, ведь для функции Join нужно указывать строковый массив.

   Замену произведите только в этой строке. В макрос я изменения внес
10. 

    Алексей
    15.01.2010 в 20:33 | #10

    а как написать макрос используя wdActiveEndAdjustedPageNumber для того что бы расставить нумерацию в верхнем колонтитуле, если я использую свою нумерацию?? Очень нужно)