1. Наш канал codeby в telegram. Пишем об информационной безопасности, методах защиты информации, о программирован. Не пропускай новости с кодебай, будь в тренде ! Подробнее ...

    Скрыть объявление
  2. Чат codeby в telegram перезагрузка. Обсуждаем вопросы информационной безопасности и методы защиты информации, программирование. Задавайте свои вопросы и комментируйте чужие. Подробнее ...

    Скрыть объявление

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

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

  1. redkaa

    redkaa Гость

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

    Tanya Гость

    Репутация:
    0
    Как вариант.

    Код:
    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 Гость

    Репутация:
    0
    Во-первых, хочу поблагодарить!
    Но много непонятностей, нужны комментарии. особенно в той конструкции, что идет в 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
      Размер файла:
      62 КБ
      Просмотров:
      18
  4. redkaa

    redkaa Гость

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

    Репутация:
    0
    возможно в случае
    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
    и (возможно)))) макрос будет работать корректнее

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

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

    redkaa Гость

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

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

    redkaa Гость

    Репутация:
    0
    во,
    про кракозябры говорят, 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 Гость

    Репутация:
    0
    ммм...
    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 Гость

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

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

    Tanya Гость

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

    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 Гость

    Репутация:
    0
    угу.
    но это вторично. куда интереснее понять про эти 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 Гость

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

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