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

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

18.12.2015, 16:03. Показов 2767. Ответов 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 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
18.12.2015, 16:03
Ответы с готовыми решениями:

чем отличается вызов объекта через "." и через "->"
Здравствуйте. Вот создал топик для тех, кто желает сам познать С++, но у которых есть вопросы по...

Работа с Excel: "object" не содержит определения для "get_Range"
скажите пожалуйста visual studio не получается выделить область в excel для выравнивания выдает...

[WPF] "Path" является неоднозначной ссылкой между "System.Windows.Shapes.Path" и "System.IO.Path"
Здравствуйте! Делаю экспорт из программы в Excel. Код брался от WinForm, немного переписал....

Как задать диапазон Shapes. Range(Array("Text box 1", "Text box 2", "Text box 3", "Text box 4"."Text box 10").Select
Здравствуйте, все. Подскажите, пожалуйста, возможно ли в макросе VBA MS Word заменить область...

3
4115 / 2221 / 939
Регистрация: 01.12.2010
Сообщений: 4,625
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
0 / 0 / 0
Регистрация: 18.12.2015
Сообщений: 11
18.12.2015, 23:10  [ТС] 3
Благодарю, с закладками разобрался, но как все таки быть если имеется обычная надпись, на которую не поставлена закладка?

Добавлено через 11 минут
Разобрался, спасибо, тема закрыта.
0
4115 / 2221 / 939
Регистрация: 01.12.2010
Сообщений: 4,625
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
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
19.12.2015, 09:30

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Для объекта конфигурации есть возможность выбирать способ редактирования ("в диалоге", "в списке", "обоими способами)" и
Доброго времени суток! НЕ могу найти это это где? Хотя тут показывают?...

Выдает ошибку - "Не удалось привести тип объекта "TheMaze.FormLevel1" к типу "System.Windows.Forms.Label"."
Ругается вот на эту строчку: ((Label)sender).Visible = false; Вот код: using System; using...

Создать 3 объекта типа Dog (собака) и присвоить им имена "Max", "Bella", "Jack"
Создать 3 объекта типа Dog (собака) и присвоить им имена "Max", "Bella", "Jack". Вот как я это...

Из слов "Работа", "крест", "тон" составить фразу "Кто не работает, тот не ест" и определить ее длину
Из слова "Работа","крест","тон" составить фразу:"Кто не работает, тот не ест" и определить ее длину.

Проблема с $word=new COM("word.application") or die("Couldn ''t start Word!");
Наблюдаю такую штуку - создаю объект Word $word=new COM("word.application") or die("Couldn ''t...

Ошибка: "Не удалось привести типа объекта "System.Windows.Forms.TextBox" к типу "System.IConvertible".""
Программа выдает такой текст: "System.InvalidCastException: "Не удалось привести типа объекта...


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

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

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