» Word VBA

PoziaSergey
Как то так

Код: Sub Zakladka()
With ActiveWindow.View
If .ShowBookmarks = False Then .ShowBookmarks = True Else .ShowBookmarks = False
End With
End Sub

Здравствуйте! Прошу помощи!

Word 2007. В шабоне вставлен элемент управления "Выбор даты" (выпадающий календарь).

Как сделать, чтобы при создании документа (на основе этого шаблона) указанное поле принимало значение "сегодня" + 1 день, т.е. - "завтра"?

То, что в шаблон нужно вставить макрос типа AutoOpen (или AutoCreate), присваивающий данному элементу определенное значение - я понимаю, но в VBA, к сожалению, не силён ... поэтому, надеюсь на помощь знатоков.

Заранее благодарю!

P.S. Элемент управления - именно "календарь", т.к. иногда нужно выбирать дату позже чем "завтра".

Товарищи подскажите пожалуйста, как в Ms Office 2010 создать надстройку для Word?

Написал необходимые макросы для Ворда, но когда коснулся вопроса сохранения файла как Надстройки не смог найти информации по данному вопросу.
Знаю, что в Excel есть возможность сохранить документ в качестве надстройки (несколько уже создавал), однако в Word не получается найти способа.

Подскажите, пожалуйста, можно ли оптимизировать скрипт? Работает, но так медленно, что проще вручную пересчитать
Задача - вывести список всех знаков, встречающихся в документе Word.

Код: Sub pr1()
Dim sl As String, i As Long
With ActiveDocument.Range.Characters
For i = 1 To .Count
If InStr(sl, .Item(i)) = 0 Then sl = sl + .Item(i)
Next
End With

Debug.Print sl

End Sub

можно попытаться чуть оптимизировать

Код:
Sub pr1()
Dim sl As String, i As Long
dim ch
With ActiveDocument.Range.Characters
For i = 1 To .Count
ch = .Item(i)
If InStr(sl, ch) = 0 Then sl = sl + ch
Next
End With

Debug.Print sl

End Sub

XPerformer
Большое спасибо!
Выходит, основное время уходило на то, чтобы каждый раз получать "ActiveDocument.Range.Characters"

одно - это коллекция объектов, тяжелая структура
второе - это строка, одним массивом передается и обрабатыватеся

Нужно запустить из макроса диалог поиска и замены, причем курсор должен оказаться в начале поля замены.
Если вызвать Dialogs(wdDialogEditReplace).Show, то после выполнения замены появляется сообщени об ошибке. Кроме того, я не знаю как перемещать курсор внутри диалогового окна.
Если же вызывать диалог с помощью SendKeys "^h", все отлично, и следующие за ним SendKeys "{TAB}"
SendKeys "{HOME}"
ставят курсор в нужное место, но возникает другая проблема: все это работает только, в том случае, если в момент вызова раскладка клавиатуры английская, если же русская - вместо вызова диалога в документ впечатываются "h" и знак табулятора.
Если принципиального решения не существует, то может кто-нибудь подскажет, как написать скрипт для определения и управления раскладкой клавиатуры.

ЗарСпасБол!

Решил проблему, но совершенно идиотским способом: назначил вызов диалога замены на Ctrl_0. Почему-то SendKeys "^0" запускается из макроса при любой раскладке.
В процессе экспериментов выяснилось, что если назначить на F11, диалог не вызывается при любой раскладке клавиатуры... Полный бред

Помогите, пожалуйста, написать скрипт для ворда, чтобы например из книги в док формате из всего массива текста взять случайным образом какие то слова и их выставить в столбец, страниц на 10.
примерно, чтобы это так выглядело
слово1
слово2
...
слово(n)

и такой столбик на 10 страниц. Единственное, чтобы слова не повторялись и выстраивались по алфавиту;)

Futurism
Как то так для активного документа
[more]

Код:
Private Sub ShellSort(ByRef this() As String)
Dim idFirst As Long, idLast As Long, tmp As String
Dim Stepping As Long, i As Long, pos As Long

idFirst = LBound(this): idLast = UBound(this)
Stepping = 1: pos = idLast - idFirst + 1
For i = 1 To pos
Stepping = 3& * Stepping + 1
If Stepping > pos Then Exit For
Next
Do
Stepping = Stepping \ 3&
For i = (Stepping + 1) To idLast
pos = i: tmp = this(i)
Do While (this(pos - Stepping) > tmp)
this(pos) = this(pos - Stepping)
pos = pos - Stepping
If (pos - Stepping) < 1 Then Exit Do
Loop
this(pos) = tmp
Next i
Loop Until Stepping = 1
End Sub

Public Sub CreateUnique()
Dim pReg As Object, pDict As Object, sText As String
Dim subStr() As String, i As Long, pDoc As Document
Set pReg = CreateObject("VBScript.RegExp")
pReg.Global = True: pReg.IgnoreCase = True
'настройка, что есть слово - всё остальное разделители
pReg.Pattern = "[^0-9a-zа-я]"
sText = Application.ActiveDocument.Range.Text
sText = pReg.Replace(sText, " ")
pReg.Pattern = "[ ]+"
sText = pReg.Replace(sText, " ")
Set pDict = CreateObject("Scripting.Dictionary")
pDict.CompareMode = 1: subStr = VBA.Split(sText, " ")
For i = LBound(subStr) To UBound(subStr)
pDict(subStr(i)) = subStr(i)
Next i
subStr = VBA.Split(VBA.Join(pDict.Keys, " "), " ")
ShellSort subStr
Set pDoc = Application.Documents.Add

pDoc.Range.Text = VBA.Join(subStr, vbCr)
End Sub

AndVGri
Очень многому научился из вашего скрипта Спасибо большое!
Подскажите, пожалуйста, а можно ли с помощью "VBScript.RegExp" выполнить такую замену: (стр1)(стр2) на (стр2)(стр1)? Если не ошибаюсь обычно для этого используется в строке поиска скобки а в строке замены "\n", но у меня почему-то не получается.
И еще, возможно ли с помощью "Scripting.Dictionary" получить информацию о количестве вхождений каждого слова?
Заранее признателен!

Vadim39

Цитата:

И еще, возможно ли с помощью "Scripting.Dictionary" получить информацию о количестве вхождений каждого слова?

Заменяем в коде

Код:
For i = LBound(subStr) To UBound(subStr)
If Not pDict.Exists(subStr(i)) Then
pDict.Add subStr(i), 1
Else
pDict(subStr(i)) = pDict(subStr(i)) + 1
End If
Next i

AndVGri
Большое спасибо!
Первый вопрос был о синтаксисе VBScript.RegExp: как указанный в паттерне шаблон передать в строку замены. Нигде не мог найти толкового описания, но в конце концов сообразил, что через "$n", где n - номер шаблона в паттерне. Правда так и не нашел способа указать в паттерне начало слова, а также способ передачи в строку замены всего найденного (в Word это делается с помощью "^&").

Если считать первую букву в слове буквой, идущей после пробела, то можно так

Код:
pReg.Pattern = " [а-яё]"
myStr = pReg.Replace(myStr, " Q")

Здравствуйте!
Хочу в скрипте проконтролировать наличие списка в ячейке таблицы. Скриптом перебираю ячейки, но ListGalleries.Count применить к ячейке не могу. Как мне это сделать?
P.S. Проблема решена -
Код: Cell.Range.ListParagraphs.Count

Столкнулся с такой трудностью:

Есть документ( word 2007), с расширением .docm, то есть с поддержкой макросов ( в самом документе есть элементы управления содержимым и макросы).
Пытаюсь этот документ сохранить как шаблон с поддержкой макросов (.dotm), чтобы на основе этого шаблона создавать новые документы с теми же работающими макросами. Проблема в том, что если на основе сохраненного шаблона создать новый документ, то макросы в нем почему-то не работают. Как добиться, чтобы макросы работали? Спасибо.

добрый день!
попал в довольно глупую ситуацию: писал большую статью, в которой должны быть скриншоты. место каждого скриншота отмечал словом "СКРИНШОТ". в итоге этих слов набралось около 500... подскажите, как ловко заменить "СКРИНШОТ" на "(Рис 1.1)", "(Рис 1.2) и т.д. номер рисунка соответствует номеру вхождения слова СКРИНШОТ в тексте.
благодарю.

brok3n
(Рис 1.1) - (Рис 1.500) ? Точно что-ли? А не (Рис 2.5) .. (Рис 10.2) ?
Алгоритм прост, х=1, затем поиск первого совпадающего слова (можно с проверкой форматирования) и замена на (Рис 1.х), потом х=х+1 , запуск поиска по новой (или через цикл с кол-вом оборотов =500) или For i=1 to 500 .. next i
можно так вобщем:
Код: Sub test()
For i = 1 To 450
Content.Find.Execute FindText:=ChrW(&H421) & ChrW(&H41A) & ChrW(&H420) & ChrW(&H418) & ChrW(&H41D) & ChrW(&H428) & ChrW(&H41E) & ChrW(&H422), ReplaceWith:="(" & ChrW(&H420) & ChrW(&H438) & ChrW(&H441) & " 1." & i & ")", MatchCase:=True, Replace:=wdReplaceOne
Next i
End Sub

vikkiv
большое спасибо! немного подкорректировал, чтобы работало )

Код: Sub test()
For i = 1 To 450
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="СКРИНШОТ", ReplaceWith:="(Рис 1." & i & ")", MatchCase:=True, Replace:=wdReplaceOne
Next i
End Sub

brok3n
Ну и отлично ... это скорее у кого как, на моей станции в установленных языках кириллицы нет, соответственно VBA без костылей её не читает и не пишет, может просто к системным шрифтам привязка идёт.
а "myRange = ActiveDocument.Content" и им подобные именно с микрософтовских VBA образцов сразу распознаются =))

Ну не изврат ли, делать обычную замену текста через VBA? Вставьте в документ название "Рис. 1." с автонумерацией, вырежьте его в буфер обмена и сделайте глобальную замену слова СКРИНШОТ на содержимое буфера обмена.

panda3
не получается именно автонумерация. подскажите, пожалуйста, и паззл будет готов )

brok3n
Да получается всё отлично. Поле нумерации надо добавлять.
Сразу копия поля вставится (с одной цифрой). Но если сохранить, и потом закрыть-открыть документ то она обновится и станет последовательной. При просмотре печати тоже обновляется, и просто на печать выводится уже обновлённая. Есть и сочетане клавишь для глобального обновления полей вроде.
Косяк может возникнуть, я не помню точно, возможно при нумерации внутри таблиц. Давно просто встречал такое, но вроде в таблице ворд не мог правильно проставить последовательность. Может и починили уже. А может это и не в таблице было, где то другом месте.
Но по тексту нормально делается.

Подскажите, пожалуйста, как скрывать/отображать определенные строки таблицы при использовании radiobutton или listbox с условием:
да - определенные строки отображаются;
нет - определенные строки скрываются;
при открытии документа таблица должна быть загружена полностью.

Alexey87
По нормальному строки нельзя скрыть в Worde, можешь использовать
Код: ActiveDocument.Tables(1).Rows(2).Range.Font.Hidden = True

Цитата:

но не должна быть включена настройка "показ скрытого текста"

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

Код: ActiveDocument.ActiveWindow.View.ShowHiddenText = False

Подскажите совсем новенькому в Word VBA - как мне макрос хоть на что то повесить?
В Excel я щелкаю правой кнопкой на объекте - "добавить макрос". В ворде же обыскался, но так ничего и не нашел...
Тут все по другому чем в Excel?

Lovec (Word 2013) File -> Options -> Customize Ribbon -> Developer (поставить галку) , Там будет "Properties" или Двойной клик где можно назначить Макрос если объект "правильный".