Мне нужно создавать закладки в Word 2003 программно на основе мест, обозначенных номером раздела - PullRequest
Новая
       13

Мне нужно создавать закладки в Word 2003 программно на основе мест, обозначенных номером раздела

1 голос
/ 25 февраля 2009

У меня есть HTML-страница со ссылками, которые при нажатии открывают для определенной закладки в текстовом документе. Я работаю с существующим документом Word 2003 без ранее существующих закладок. Я хочу добавить закладки во все местоположения заголовка номера раздела, используя макрос или скрипт VBA. Пример

3.1.4.2 ЗДЕСЬ
STUFF
3.1.4.2.1 Здесь снова
БОЛЬШЕ ПЕРСОНАЛА
3.1.4.2.1.1 И здесь снова
ДАЖЕ БОЛЬШЕ ПЕРСОНАЛА
3.1.4.2.2 Здесь снова снова
МНОГО БОЛЬШЕ ПЕРСОНАЛА

Я хочу отметить все строки, которые начинаются с X.X.X ... со стандартным форматом для имени.

Пример (используя выше в качестве ссылки)

3.1.4.2 ЗДЕСЬ строка будет иметь метку с именем M_3_1_4_2
3.1.4.2.1 Здесь также должна быть метка книги с именем M_3_1_4_2_1

и т.д.

У меня вопрос, какой подход со сценарием VBA или макросом мне понадобится, чтобы это произошло.

Ответы [ 2 ]

2 голосов
/ 25 февраля 2009

Добавление закладки достаточно просто, если у вас уже есть объект диапазона. 

ActiveDocument.Bookmarks.Add Name:=rngBookmark.Text, Range:=rngBookmark

Получение диапазона часто является сложной задачей. Теперь вы сказали, что это заголовки разделов. Это настоящие заголовки разделов слов? Они ограничены определенным стилем? Они находятся в теле документа или в заголовках страниц?

Вы можете циклически перемещаться по разделам документа, подобным этому, и устанавливать диапазон для начала раздела. 

Dim sectCurrent As Word.Section
Dim rngCurrent As Word.Range
For Each sectCurrent In ActiveDocument.Content.Sections

   ' get range that refers to the whole section
   Set rngCurrent = sectCurrent.Range.Duplicate

   ' collapse the range to the start of the section
   rngCurrent.Collapse wdCollapseStart

   ' expand the range to hold the first "word"
   ' you can also use other units here like wdLine
   rngCurrent.MoveEnd Unit:=wdWord, Count:=1

   ' now that you have the range you can add the bookmark
   ' you can process the range and create your own name with a custom function GenerateBookmarkName.  To get the string, just use rngCurrent.Text.
   ActiveDocument.Bookmarks.Add Name:=GenerateBookmarkName(rngCurrent), Range:=rngCurrent

Next sectCurrent

Теперь, если они не являются реальными разделами, вам часто нужно использовать объект Find, чтобы найти что-то в документе и просмотреть все такие элементы. Хитрость в том, чтобы узнать, что искать. Пример цикла приведен ниже. 

   ' setup range object for search results
   Set rngFind = ActiveDocument.Content

   ' cycle through search results looking for whatever
   With rngFind.Find

      ' search text
      .Text = "FINDME"
      .Format = False
      .Wrap = wdFindStop

      ' loop while find is successfull
      Do While .Execute

         ' get range you can modify based on found item
         ' each time you call .Execute rngFind is changed to the found text
         Set rngModifyMe = rngFind.Duplicate    


      Loop

   End With

Чтобы получить дополнительную помощь по слову vba, вы можете посетить сайт MVP здесь: http://word.mvps.org

1 голос
/ 31 августа 2017 
    Public Sub HeadingsToBookmarks()
        Dim strText As String
        Dim heading As Range
        Dim hpara As Range
        Dim ln As Integer
        Set heading = ActiveDocument.Range(Start:=0, End:=0)
        Do
            Dim current As Long
            current = heading.Start
            Set heading = heading.GoTo(What:=wdGoToHeading, Which:=wdGoToNext)
            If heading.Start = current Then
                Exit Do
            End If
            Set hpara = heading.Paragraphs(1).Range
            strText = Trim(Left(hpara.Text, Len(hpara.Text) - 1))
            ln = Len(strText)
            If ln > 0 Then
                strText = Trim(RegExp_Replace(strText, "[0-9./-]*", ""))
                strText = Trim(RegExp_Replace(strText, " +", "_"))
                ActiveDocument.Bookmarks.Add Name:=strText, Range:=heading.Paragraphs(1).Range
            End If
        Loop
    End Sub
    Function RegExp_Replace(ReplaceIn, sPattern As String, ReplaceWith As String, Optional IgnoreCase As Boolean = False, _
        Optional GlobalMatch As Boolean = False, Optional bMultiLine As Boolean = False)
        Dim RE
        Set RE = CreateObject("vbscript.regexp")
        RE.Pattern = sPattern
        RE.IgnoreCase = True
        RE.Global = True
        RE.MultiLine = True
        RegExp_Replace = RE.Replace(ReplaceIn, ReplaceWith)
    End Function
...