Уменьшение шрифта пустого абзаца на один пункт.

[Busine2009]

Мне витер писал макрос для уменьшения пустых абзаце на один пункт на текущей странице - это очень сложно для ворда или для моего компа на работе. Нельзя уменьшить пустые абзацы на 1 пункт в выделенной области: то есть я вручную выделяю страницу, а затем применяю макрос.

[viter.alex]

Вы хоть напишите макрос, который я вам написал. Там изменить-то всего пару строчек

[Busine2009]

Sub SearchOnCurrentPage()
  'Запоминаем в переменную oRng диапазон всего документа
  Dim oRng As Range: Set oRng = ActiveDocument.Range
  'Расширяем этот диапазон до положения курсора
  oRng.SetRange oRng.Start, Selection.Range.Start
  'Запоминаем в переменную oRng начало страницы, на которой находится курсор
  Set oRng = ActiveDocument.Range.GoTo(wdGoToPage, , oRng.ComputeStatistics(wdStatisticPages))
  'Расширяем диапазон, хранящийся в переменной oRng, до начала следующей страницы.
  'Таким образом в нашей переменной окажется вся страница, на которой в данный момент находится курсор.
  oRng.SetRange oRng.Start, oRng.GoToNext(wdGoToPage).Start
  'Запоминаем номер последнего символа на текущей странице
  Dim iEnd&: iEnd = oRng.End
  With oRng.Find
  'На нужной странице, диапазон которой хранится в переменно oRng, ищем знаки абзацев
    .Text = "^p"
    'Если знак абзаца найден
    While .Execute
      'При поиске диапазон почему-то меняется, поэтому выполняем проверку, что мы не вышли за пределы
      If .Parent.End <= iEnd Then
        'Если в найденном абзаце находится только один символ — знак абзаца
        If Len(.Parent.Paragraphs(1).Range.Text) = 1 Then
          'то уменьшаем его шрифт на 1
          .Parent.Paragraphs(1).Range.Font.Size = .Parent.Paragraphs(1).Range.Font.Size - 1
        End If
      End If
    Wend
  End With
End Sub

То есть нужен макрос не для range, а для selection.

Кстати этот макрос не работает на 1 и последней страницах.

[viter.alex]

Согласен, макрос не работает на последней странице. Исправил. Еще раз подчеркну: макрос работает только со страницей, на которой находится курсор. Эту страницу даже выделять не нужно.

Sub SearchOnCurrentPage()
  Dim iPgRng%, iPgsCnt%, iRngEnd&
  'Запоминаем в переменную oRng диапазон всего документа
  Dim oRng As Range: Set oRng = ActiveDocument.Range
  'Расширяем этот диапазон до положения курсора
  oRng.SetRange oRng.Start, Selection.Range.Start
  'Количество страниц в нашем диапазоне
  iPgRng = oRng.ComputeStatistics(wdStatisticPages)
  'Количество страниц в документе
  iPgsCnt = ActiveDocument.Range.ComputeStatistics(wdStatisticPages)
  'Запоминаем в переменную oRng начало страницы, на которой находится курсор
  Set oRng = ActiveDocument.Range.GoTo(wdGoToPage, , iPgRng)
  'Расширяем диапазон, хранящийся в переменной oRng, до начала следующей страницы.
  'Если количество страниц в диапазоне oRng равно количество страниц в документе, то _
  курсор находится на последней странице. Исходя из этого, определяем позицию в документе, _
  до которой будем расширять наш диапазон. Если курсор находится на последней странице, то _
  расширяем до конца документа, если нет, то расширяем до начала следующей страницы.
  iRngEnd = IIf(iPgRng = iPgsCnt, ActiveDocument.Range.End, oRng.GoToNext(wdGoToPage).Start)
  'Таким образом в нашей переменной окажется вся страница, на которой в данный момент находится курсор.
  oRng.SetRange oRng.Start, iRngEnd
  'Запоминаем номер последнего символа на текущей странице
  Dim iEnd&: iEnd = oRng.End
  With oRng.Find
  'На нужной странице, диапазон которой хранится в переменно oRng, ищем знаки абзацев
    .Text = "^p"
    'Если знак абзаца найден
    While .Execute
      'При поиске диапазон меняется, поэтому выполняем проверку, что мы не вышли за пределы
      If .Parent.End <= iEnd Then
        'Если в найденном абзаце находится только один символ — знак абзаца
        If Len(.Parent.Paragraphs(1).Range.Text) = 1 Then
          'то уменьшаем его шрифт на 1
          .Parent.Paragraphs(1).Range.Font.Size = .Parent.Paragraphs(1).Range.Font.Size - 1
        End If
      Else: Exit Sub
      End If
    Wend
  End With
End Sub

[Busine2009]

А как уменьшить знак абзаца в выделенной области? Дайте хоть подсказку.

[Busine2009]

Почему при выполнении этого макроса, происходит подсчет слов? Можно ли избежать этого, т.к. на подсчет слов уходит около 10 сек. А когда нажимаешь во время подсчета слов на Esc, то подсчет слов останавливается и выполняется макрос?