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

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

1. 

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

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

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

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

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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

   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

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

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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64

   'Функция сортировки строки по возрастанию 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

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

   1 2	'Сортируем числа в строке по возрастанию с помощью специальной функции   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 для того что бы расставить нумерацию в верхнем колонтитуле, если я использую свою нумерацию?? Очень нужно)