Быстрое добавление закладки

[Frommerrr]

Такой вопрос. Вот есть к примеру такой текст, как ниже. Возможно ли с помощью макроса сделать так, чтобы выделив мышкой жирный текст одним нажатием кнопки макроса или сочетанием клавиш добавить закладку в документ именно с именем выделенного текста? И чтобы потом можно было выделить другой текст и также добавить в закладки, но так чтобы первая закладка не пропала. Для меня тяжело бывает когда ты выделяешь текст, потом открываешь добавить закладку, вставляешь текст, заменяешь пробелы к примеру нижним подчеркиванием и только потом нажимаешь ок. Нельзя ли это автоматизировать -- выделил текст - нажал кнопку - закладка готова?

Доиндустриальное общество. Эту стадию также принято называть традиционной или аграрной.

[viter.alex]

Попробуй так.

Sub QuickBookmark()
  ActiveDocument.Bookmarks.Add Replace(Selection.Text, " ", "_"), _
  Selection.Range
End Sub

[Frommerrr]

Спасибо Вам viter.alex. А если в конце слова не пробел, а запятая закладка не создается, что нужно в коде исправить?

[viter.alex]

Использованная мной функция Replace заменяет в строке пробелы на подчёркивание. Аналогично можно удалить и другие "неправильные" символы. Додумайте сами

[Frommerrr]

Ув. viter.alex додумался только до этого, но после создания закладки, в тексте удаляются те символы которые я удалил, а мне нужно чтобы они вернулись в то состояние в котором были изначально. Добиться этого можно только тем, что после создания закладики два раза нажать отмену операции (Ctrl+Z). А без отмены можно как-нибудь. Помогите или скажите где копать.


Sub QuickBookmark()
With Selection.Find
.Text = "[,]"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
ActiveDocument.Bookmarks.Add Replace(Selection.Text, " ", "_"), _
Selection.Range
Selection.Collapse direction:=wdCollapseStart
End Sub

[viter.alex]

Эт вы круто взяли с поиском и заменой! Но в данном случае всё гораздо проще:

Sub QuickBookmark()
  Dim sBmName As String
  'Заменяем пробелы на подчёркивания
  sBmName = Replace(Selection.Text, " ", "_")
  'Удаляем запятые
  sBmName = Replace(sBmName, ",", "")
  ActiveDocument.Bookmarks.Add sBmName, Selection.Range
End Sub

[Frommerrr]

Термин "Макиавеллизм".

Всплыл еще один вопрос. Если удалять знаки, как Вы научили, то запинка происходит, когда нужно создать закладку из текста указанного выше. Так же не получается с длинным тире (при вставке в редактор он заменяется на дефис). Просто хочется делать закладку из любого текста. Это возможно в принципе? С уважением.

Sub QuickBookmark()
Dim sBmName As String
'Заменяем пробелы на подчёркивания
sBmName = Replace(Selection.Text, " ", "_")
'Удаляем запятые
sBmName = Replace(sBmName, ",", "")
sBmName = Replace(sBmName, "-", "")
sBmName = Replace(sBmName, ".", "")
sBmName = Replace(sBmName, ";", "")
sBmName = Replace(sBmName, ":", "")
sBmName = Replace(sBmName, "?", "")
sBmName = Replace(sBmName, "!", "")
sBmName = Replace(sBmName, "(", "")
sBmName = Replace(sBmName, ")", "")
ActiveDocument.Bookmarks.Add sBmName, Selection.Range
End Sub

[viter.alex]

Возможно. Кавычку нужно записать так:

""""

А длинное тире записывается так (151 — это код символа)

ChrW(151)

т.е. получится

sBmName = Replace(sBmName, """", "") 'Для кавычки
sBmName = Replace(sBmName, Chr(151), "") 'Для длинного тире

На всякий случай: короткое тире (–) имеет код 150, левая угловая кавычка («) имеет код 171, а правая (») — 187

[Frommerrr]

Странно - с кавычками получается, а с длинным тире никак. Делал как научили.

[viter.alex]

Выдели это длинное тире и запусти такой макрос:

Sub GetCode()
  MsgBox Asc(Selection.Text)
End Sub

Посмотри какой код символа возвращает. Длинное тире должно отделяться слева неразрывным пробелом, его тоже нужно удалять. Его код — 160

Добавлено позже
Моя вина. Вместо ChrW нужно использовать Chr. В примере внёс исправления