макрос, который переставляет абзацы

[мария945]

Суть задания такова, разработать макрос для документа мс ворд для запуска макроса зарезервировать горячую клавишу. абзацы с четным количеством слов перенести в начало документа. Кажется здесь с этим справляются легко, а для меня VBA штука незнакомая

[Sasha_Smirnov]

С английским-то, думаю, знакомы. Вот цитата из справки VBE с кодом как раз для вас.

This example displays the number of words and characters in the first paragraph of Report.doc.

Set myRange = Documents("Report.doc").Paragraphs(1).Range
wordCount = myRange.ComputeStatistics(Statistic:=wdStatisticWords)
charCount = _
    myRange.ComputeStatistics(Statistic:=wdStatisticCharacters)
MsgBox "The first paragraph contains " & wordCount _
    & " words and a total of " & charCount & " characters."

Вообще, мария945, это сугубо учебное задание: за 28 лет я ни разу такого вопроса на работе не решал (да его там и не стояло: мало кто знает, что есть VBA!)

Вот запись макроса (лишнее убрал):

Sub Макрос7() ' Макрос записан 12.12.15
    NormalTemplate.AutoTextEntries.AppendToSpike Range:=Selection.Range
    Selection.HomeKey Unit:=wdStory
    With NormalTemplate.AutoTextEntries("Копилка")
        .Insert Where:=Selection.Range, RichText:=True
    End With
End Sub

Здесь отражены (благодаря макрорекордеру Word) те манипуляции, что на работе обычно делают без всяких макросов: вырезают (по Ctrl-F3) и затем в нужное место (в данном случае в начало) вставляют (по Ctrl-Shift-F3).

Ещё за 20 минут тему посмотрели 10 человек (61→71), а у меня под утро созрело следующее:

Sub ПарыНаверх()
Dim abz As Paragraph

For Each abz In ActiveDocument.Paragraphs
    If abz.Range.ComputeStatistics(wdStatisticWords) Mod 2 = 0 Then _
        NormalTemplate.AutoTextEntries.AppendToSpike Range:=abz.Range
Next

    Selection.HomeKey Unit:=wdStory
    With NormalTemplate.AutoTextEntries("Копилка")
        .Insert Where:=Selection.Range, RichText:=True
    End With
End Sub

Слово за вами, мария945 и мария954!