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

Тема в разделе "Visual Basic", создана пользователем redkaa, 21 июл 2008.

  1. redkaa

    redkaa Гость

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

    Tanya Гость

    Как вариант.

    Код (Text):
    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
     
  3. redkaa

    redkaa Гость

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

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

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

    Вложения:

    • Picture_1.png
      Picture_1.png
      Размер файла:
      62 КБ
      Просмотров:
      18
  4. redkaa

    redkaa Гость

    продвигаюсь! :)
    почитал хелп, поизучал примеры - вроде конструкции должны были быть синтаксически правильными.
    удалил код, начал заново, вместо копипейста написал все руками - теперь вроде бы все работает!
    но забыл уточнить: новый док должен содержать просто список:
    абзац(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)
    решительно ничего не понимаю. чертовщина какая-то...
     
  5. Tanya

    Tanya Гость

    возможно в случае
    n = Selection.Paragraphs.Count

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

    Код (Text):
    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
    и (возможно)))) макрос будет работать корректнее

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

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

    redkaa Гость

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

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

    redkaa Гость

    во,
    про кракозябры говорят, 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 :)

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

    Tanya Гость

    ммм...
    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
     
  9. redkaa

    redkaa Гость

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

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

    Tanya Гость

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

    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
     
  11. redkaa

    redkaa Гость

    угу.
    но это вторично. куда интереснее понять про эти 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]
     
  12. redkaa

    redkaa Гость

    Продолжение истории вот здесь
    http://www.officeformac.com/?13@@.59b5505b/5
    честно говоря, чертовщина какая-то происходит, честное пионерское!
     
Загрузка...

Поделиться этой страницей