Помогите написать макрос для ворда

  • Автор темы redkaa
  • Дата начала
R

redkaa

Гость
#1
Задача следующая: есть большой документ, разделенный на секции разрывом страницы (вставка-разрыв страницы). Секции могут содержать сразу несколько страниц.
нужно из каждой секции брать второй и первый абзацы и помещать их в соседний документ.
вопросы: как удобнее всего обращаться к этим секциям? в справке по макросам ничего подходящего не нашел. может, в ворде предусмотрены свои механизмы? или придется специально что-то сочинять? как сохранять текст в другой документ? (впрочем, с этим постараюсь разобраться сам).
 
T

Tanya

Гость
#2
Как вариант.

Код:
Sub nn()
Dim dSource As Document, dDest As Document
Dim p As Paragraph
Dim j As Integer

Set dSource = Application.ActiveDocument
Set dDest = Documents.Add(, , , True)

Set p = dSource.Paragraphs(1)
j = 1

Do While Not p Is Nothing
If Asc(p.Range.Characters(1)) = 12 Then
dDest.Paragraphs(dDest.Paragraphs.Count).Range.InsertBreak wdPageBreak
j = 1
End If

If j < 4 Then
dDest.Paragraphs.Add.Range.Text = p.Range.Text
j = j + 1
End If

Set p = p.Next
Loop

dDest.SaveAs "MyDoc.doc"
End Sub
 
R

redkaa

Гость
#3
Во-первых, хочу поблагодарить!
Но много непонятностей, нужны комментарии. особенно в той конструкции, что идет в while
почему j <4? зачем эта строчка?
Asc(p.Range.Characters(1)) = 12 - что это за выражение? откуда 12? символ разрыва страницы?
у меня по какой-то причине при запуске в тестовом документе пишет ошибку
Compile error: Type mismatch
и выделена буква p в строчке   Set p = dSource.Paragraphs(1)
плюс к тому желтым цветом выделена строчка Sub nn() и на нее указывает желтая же стрелка
к сожалению сижу на маковском ворде, и здесь, похоже, отладка не работает :-(((

еще почему-то конструкция while выполнена красным шрифтом.
в приложении - скриншот.
еще по плану было выделить первую строчку жирным, увеличить фонт, сделать на нее якорь.

эх, не успеваю с завтрашним днем - похоже, опять придется вручную перелопачивать :-(
 

Вложения

R

redkaa

Гость
#4
продвигаюсь! :)
почитал хелп, поизучал примеры - вроде конструкции должны были быть синтаксически правильными.
удалил код, начал заново, вместо копипейста написал все руками - теперь вроде бы все работает!
но забыл уточнить: новый док должен содержать просто список:
абзац(0)1:абзац(0)2
абзац(1)1:абзац(2)2
..
абзац(5)1:абзац(5)2
и т.д.
простым + пока обойтись не получается. видимо, нужны какие-то преобразования типов?

с форматированием первых абзацев в исходном документе вроде бы что-то получается.
круто! спасибо огромное!!!

тьфу. спутал апострофы и стандартные кавычки.
но все равно, не могу избавиться в dDest от символов разрыва страницы
хоть потом вручную удаляй...

не догоняю: в последнем if изменил строчки следующим образом:
mytext = "++"
dDest.Paragraphs.Add.Range.Text = p.Range.Text + mytext
j = j + 1
почему-то два плюса появляются лишь на последней странице dDest - почему так?

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

[codebox]Sub nn()
Dim dSource As Document, dDest As Document
Dim p As Paragraph
Dim j As Integer, k As Integer

Set dSource = Application.ActiveDocument
Set dDest = Documents.Add(, , , True)
Set p = dSource.Paragraphs(1)
j = 1
k = 1
Do While Not p Is Nothing
If Asc(p.Range.Characters(1)) = 12 Then
' dDest.Paragraphs(dDest.Paragraphs.Count).Range.InsertBreak wdLineBreak
j = 1
End If

If j < 3 Then
If j = 1 Then
p.Range.Font.Bold = True
p.Range.Font.Size = 16
dSource.Bookmarks.Add Name:="ros" + CStr(k), Range:=p.Range
'MsgBox p.Range
k = k + 1
End If

mytext = "++"
dDest.Paragraphs.Add.Range.Text = p.Range.Text + mytext
j = j + 1
End If
Set p = p.Next
Loop
'dDest.SaveAs "MyDocccab.doc"
End Sub

[/codebox]


кажется, с якорем начал догонять. просто макрос для каждого раздела первый абзац берет вместе с символом разрыва страницы.
хм.
интересно, а можно использовать что-то типа trim? не уверен, насколько это будет правильно в конструкции с якорями... :-(

ура!
все сделал!
спасибо большое, Tanya!
Воспользовался такой громоздкой конструкцией

Set aRange = p.Range
aRange.SetRange Start:=aRange.Start + 1, End:=aRange.End
dSource.Bookmarks.Add Name:="ros" + CStr(k), Range:=aRange



теперь другая фигня
простой код:
[codebox]Sub Compile_Menu()
i = 1
n = Selection.Paragraphs.Count
m = InputBox("Cumon!", "Type in da title", "mymenu")
For i = 1 To n
s = Selection.Paragraphs(i)
ActiveDocument.Hyperlinks.Add anchor:=s, _
SubAddress:=m + CStr(i)
Next i

End Sub
[/codebox]
на полутора страницах вдруг выдает ошибку на 21 абзаце
Fields are nested too deeply
и потом
Run-time error '5941'
The requested member of the collection does not exist
на строчке s = Selection.Paragraphs(i)
в чем дело - не могу разобраться :-(

чертовщина какая-то.
на 20 итерации почему-то selection.paragraps.count устанавливается в единицу и происходит обращение к несуществующему абзацу.
в чем может быть дело?



удивительное дело!
с таким вот кодом:
[codebox]
Set dSource = Application.ActiveDocument
n = dSource.Paragraphs.Count
m = "mymenu"
MsgBox s
For i = 1 To n
Set s = dSource.Paragraphs(i).Range
dSource.Hyperlinks.Add anchor:=s, SubAddress:=m + CStr(i)
MsgBox CStr(i) + " : " + CStr(dSource.Paragraphs.Count)
Next i[/codebox]
все равно при n=24 четыре раза выскакивала ошибка про nested too deeply, но скрипт свое отработал (после четырех лишних нажатий на enter)
решительно ничего не понимаю. чертовщина какая-то...
 
T

Tanya

Гость
#5
возможно в случае
n = Selection.Paragraphs.Count

выделение снимается, и затем происходит обращение к абзацу с номером, которого нет в текущем выделении
поэтому можно заменить тот макрос на следующий

Код:
Sub Compile_Menu()
Dim f As Range
i = 1
Set f = Selection.Range
n = f.Paragraphs.Count
m = InputBox("Cumon!", "Type in da title", "mymenu")
For i = 1 To n
s = f.Paragraphs(i)
ActiveDocument.Hyperlinks.Add Anchor:=s, SubAddress:=m + CStr(i)
Next i
End Sub
и (возможно)))) макрос будет работать корректнее

для второго случая, когда работаешь с целым документом
ошибку отловить не удалось, поэтому сказать ничего не могу (((
возможно это связано со специфическим форматированием исходного документа

пройди по шагам и посмотри где выдает ошибку, на каком абзаце, что в нем
может так увидишь, что там такого уникального )))
 
R

redkaa

Гость
#6
спасибо за оперативный ответ!
поменял на этот вариант - все равно выскакивает сообщение fields are nested too deeply на 20 строчке. причем не важно, что это за текст. пробовал на рабочем документе - ошибки. создал новый - в каждой строчке по числу, запустил макрос - на 20 строке он начал ругаться. нажать несколько раз enter (у меня в примере 24 строки) - он вроде отрабатывает в остальном корректно.
что за сообщение, какие fields - не ясно.
такое ощущение, что неправильно линк создаю и что-то меняю в структуре документа (fields - это оттуда?)

еще проблема - с кодировками.
если делать msgbox "русский текст" у меня русский текст выскакивает кракозябрами. видимо, это маковское наследие. хотя, может и под виндой те же проблемы?
 
R

redkaa

Гость
#7
во,
про кракозябры говорят, It is not generally possible to use Unicode in this version of VBA.
Stick to ANSI
про ошибку nested -
You are not moving your selection.range inside the loop, so you are placing
each field inside the previous one, until they are indeed too deeply nested :)

но я из этого мало что понял.
 
T

Tanya

Гость
#8
ммм...
SubAddress:=m + CStr(i)

из справки:
SubAddress Optional Variant. The name of a location within the destination file, such as a bookmark, named range, or slide number.
то есть, что-то типа именованного диапазона, закладки и slide number (не знаю что такое )))

fields are nested too deeply - типа слишком большая вложенность
возможно, где-то стоит ограничение на количество вложенности полей, закладок и т.п.

вопрос в том, что за документ у тебя и что ты заносишь в SubAddress , вернее даже, что такое "mymenu"
закладка или поле или что-то другое?

По поводу кракобяз, наверное нужно перекодировать из Unicode
 
R

redkaa

Гость
#9
bookmark.
я создаю гиперссылку на закладку в этом же документе. поэтому сама ссылка пустая, а я формирую только часть, которая идет после решетки #
говорю же, если запустить этот скрипт в документе из 25 строчек (просто в каждую строчку по числу), ругань начинается с двадцатой строки.
выше товарищ по-моему из микрософта сказал, что я не передвигаю selection.range внутри цикла (а как его передвигать, и зачем?) и по всей видимости каждую новую закладку (поле? field?) я делаю внутри предыдущей. на мой взгляд, чертовщина какая-то.

в VBA существуют встроенные функции перекодирования из Unicode? Фигня в том, что в самом макросе без лишних извращений я не могу задать жестко строку с русскими символами (в тексте программы они уже пишутся кракозябрами)
 
T

Tanya

Гость
#10
Для перекодировки вроде вот эта функция должна подойти:

StrConv(string, conversion, LCID)
string что кодируем
conversion = vbFromUnicode
LCID необязательный

в общем в справке по - английски есть полное описание )))
Пример оттуда же
StrConv Function Example
This example uses the StrConv function to convert a Unicode string to an ANSI string.

Dim i As Long
Dim x() As Byte
x = StrConv("ABCDEFG", vbFromUnicode) ' Convert string.
For i = 0 To UBound(x)
Debug.Print x(i)
Next
 
R

redkaa

Гость
#11
угу.
но это вторично. куда интереснее понять про эти nested fields.
вот какой пример нашел на сайте микрософта. плохо понял, что и для чего...

...However, if you really need to create the field “on the fly”, you will have to use selections instead of ranges; for example:
[codebox]Sub InsertHyperLinkFieldWithinMacroButtonField()

Application.ScreenUpdating = False
ActiveWindow.View.ShowFieldCodes = True

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"HYPERLINK ""http://www.mvps.org/word/""", PreserveFormatting:=False
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.InsertAfter "MacroButton ""FollowLink"""
ActiveWindow.View.ShowFieldCodes = False
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

Selection.Fields.Update
Application.ScreenUpdating = True

End Sub[/codebox]