Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.55/11: Рейтинг темы: голосов - 11, средняя оценка - 4.55
apsky
0 / 0 / 0
Регистрация: 18.12.2015
Сообщений: 11
1

"работа с выделением Selection объекта word.Bookmarks и .shapes через excel"

18.12.2015, 16:03. Просмотров 2027. Ответов 3
Метки нет (Все метки)

Доброе время суток. Возникла проблема: Суть
имеется 2 макроса оба запускаются из excel
1-ый выбираем файлы word, создаем таблицу Имя Индекс Путь
2-ой заменяет колонтитулы в этих файлах
Проблема:
В каждом из файлов word имеется надпись к которой привязана закладка
Необходимо в данной надписи через Shapes или же через саму закладку Bookmark выполнить обычные преобразования через Selection.Find т.е заменить текст на какой-либо

Сами макросы:
Sub tablefiles() ' задает таблицу из имен выбранных файлов с полями Имя файла Индекс Путь файла
Dim oFD As Object
Dim lf As Long
Dim x, y As String
Dim pos, name As String
Dim count, countItems As Long
With ActiveWorkbook.ActiveSheet
.Cells.Clear
End With
Cells(1, 1) = "Имя файла"
Cells(1, 2) = "Номер учетника"
Cells(1, 3) = "Путь к файлу"
count = 1
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD
.AllowMultiSelect = True
'.Title = "
'.Filters.Clear '
.Filters.Add "word files", "*.doc;*.docx", 1 '
'.Filters.Add "Text files", "*.txt", 2 '
'.FilterIndex = 2 '
.InitialFileName = "C:\Users\Павел\Desktop\Макросы" 'Указать папку с файлами
.InitialView = msoFileDialogViewDetails '
If oFD.Show = 0 Then Exit Sub '
For lf = 1 To .SelectedItems.count
countItems = .SelectedItems.count
x = .SelectedItems(lf)
pos = InStrRev(x, "")
name = Right(x, Len(x) - pos)
y = name
Cells(1 + count, 3) = x
Cells(1 + count, 1) = y
count = count + 1
Next
End With
End Sub

Первый макрос работает корректно

Sub Openfiles() ' после добавления нового столбца в таблицу задает нижние колонтитулы файлам
With ActiveWorkbook.ActiveSheet
Dim way, kolon As String
Dim x, r1, r2 As range
Dim i, j, z As Long
Dim word As Object
Dim doc As Object
z = 1
Set x = range("C2:C20")
End With
For k = 2 To 50
If Not Cells(k, 3).Text = "" Then
way = Cells(k, 3)
kolon = Cells(k, 2) '.HorizontalAlignment = xlCenter
' расставляем колонтитулы в файле
Set word = CreateObject("Word.Application")
Set doc = word.Documents.Open(way)
With word.Selection
.PageSetup.DifferentFirstPageHeaderFooter = True
End With
word.ActiveWindow.ActivePane.View.SeekView = 5
With word.Selection
.Wholestory
.TypeText Text:="Уч. № "
.TypeText Text:=kolon
.ParagraphFormat.Alignment = 1 ' по центру
End With
word.Browser.Next
word.ActiveWindow.ActivePane.View.SeekView = 0
word.ActiveWindow.ActivePane.View.SeekView = 10
With word.Selection
.Wholestory
.TypeText Text:="Уч. № "
.TypeText Text:=kolon
.ParagraphFormat.Alignment = 1
End With
word.ActiveWindow.ActivePane.View.SeekView = 0
word.Visible = True 'скрытый word
'_________________________Здесь проблема

'For i = 1 To word.ActiveDocument.bookmarks.count
'with word.ActiveDocument.bookmarks(i).Select
Selection.Find.Text = "123"
Selection.Find.Replacement.Text = "3333"
Selection.Find.Execute Replace:=wdReplaceAll
' End With
' Next i
'________________________________________
'doc.Save
'doc.Close
'конец расстановки
Else
Exit For
End If
Next k
'End With
End Sub


Собственно проблема в части кода

For i = 1 To word.ActiveDocument.bookmarks.count
'with word.ActiveDocument.bookmarks(i).Select
Selection.Find.Text = "123"
Selection.Find.Replacement.Text = "3333"
Selection.Find.Execute Replace:=wdReplaceAll
' End With
' Next i
Не работает
пробовал разные варианты:

For i = 1 To word.ActiveDocument.bookmarks.count
'with word.ActiveDocument.bookmarks(i).Select
word.Selection.Find.Text = "123"
word.Selection.Find.Replacement.Text = "3333"
word.Selection.Find.Execute Replace:=wdReplaceAll
' End With
' Next i
Ничего не делает

Помогите разобраться
Приложил 2 файла
Excel с макросами
Word для теста
0
Вложения
Тип файла: docx one.docx (23.8 Кб, 3 просмотров)
Тип файла: xlsx Макросы.xlsx (7.4 Кб, 4 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.12.2015, 16:03
Ответы с готовыми решениями:

Создание объекта "Книга Microsoft Excel"
Не могу из повер поинт в ВБА обратиться к открытой книге эксель (ни по индексу ни по названию,...

Пройтись по Shapes("Rectangle 2") всех листов презентации
Нужно как-то пройтись по всех Shapes("Rectangle 2"), те по заголовочным формам, всех листов...

Замена текста в в word на "текст с гиперссылкой" из Excel
Здравствуйте! на просторах интернета нашел макрос, который который заменяет в ворд файле текст,...

Через VBA отключить "Непечатываемые знаки" для документа Word.
Снова я. Собственно снова сабж. __________________ Мои вопросы - ваши ответы. Вопрос: Через...

Автофильтр Selection.AutoFilter Field:=3, Criteria1:="Москва"
С помощью автофильтра выбираю, например, Selection.AutoFilter Field:=3, Criteria1:="Москва" ...

3
pashulka
3398 / 1836 / 767
Регистрация: 01.12.2010
Сообщений: 3,648
18.12.2015, 16:47 2
Если говорить только о закладках, то :

Замена текста в одной закладке

Visual Basic
1
2
3
4
5
With doc.Bookmarks("yyy").Range.Find 'doc.Bookmarks(1)
     .Text = "123"
     .Replacement.Text = "3333"
     .Execute Replace:=2 'wdReplaceAll
End With
Во всех закладках документа

Visual Basic
1
2
3
4
5
6
7
8
Dim objBM As Object
For Each objBM In doc.Bookmarks
    With objBM.Range.Find
         .Text = "123"
         .Replacement.Text = "3333"
         .Execute Replace:=2 'wdReplaceAll
    End With
Next
или

Visual Basic
1
2
3
4
5
Dim objBM As Object
For Each objBM In doc.Bookmarks
    objBM.Range.Find.Execute _
    FindText:="123", ReplaceWith:="3333", Replace:=2 'wdReplaceAll
Next
0
apsky
0 / 0 / 0
Регистрация: 18.12.2015
Сообщений: 11
18.12.2015, 23:10  [ТС] 3
Благодарю, с закладками разобрался, но как все таки быть если имеется обычная надпись, на которую не поставлена закладка?

Добавлено через 11 минут
Разобрался, спасибо, тема закрыта.
0
pashulka
3398 / 1836 / 767
Регистрация: 01.12.2010
Сообщений: 3,648
19.12.2015, 09:30 4
Давайте не будем эгоистами и подскажем всем, у кого возникла аналогичная задача, что заменить текст в обычных надписях (которые не "скрываются" в колонтитулах и т.п.) можно, например, так :

Visual Basic
1
2
3
4
5
6
7
8
9
10
Dim objShape As Shape
For Each objShape In doc.Shapes
    If objShape.Type = msoTextBox Then
       With objShape.TextFrame.TextRange.Find
            .Text = "123"
            .Replacement.Text = "3333"
            .Execute Replace:=2 'wdReplaceAll
       End With
    End If
Next
Если же в документе нет других об'ектов, кроме надписей и нас не интересует сохранение исходного форматирования, то :

Visual Basic
1
2
3
4
5
6
Dim objShape As Shape
For Each objShape In doc.Shapes
    With objShape.TextFrame.TextRange
         .Text = Replace(.Text, "123", "3333")
    End With
Next
Добавлено через 9 часов 9 минут
P.S. При использовании позднего связывания - As Shape нужно заменить на As Object 'Variant
0
19.12.2015, 09:30
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.12.2015, 09:30

Нужен обновляемый диапазон Selection.AutoFill Destination:=Range("B3:B10278")
Доброго времени суток. Есть таблица в которой каждый день будут добавляться данные по столбцу. Но...

Как связать "поле со списком" с полем "форматированный текста" Word
Подскажите как связать "поле со списком" с полем "форматированный текста". к примеру из "поле...

После выгрузки формы - Прекращена работа программы "Microsoft Excel"?
Добрый день! Уважаемые форумчане :), Беда. Просто беда :(... Написал макрос для контекстного поиска...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.