Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.03.2024, 08:46   #1
01234567898
Новичок
Джуниор
 
Регистрация: 22.03.2024
Сообщений: 1
По умолчанию VBA exel: найти текст в файле Word и вставить в Exel

Доброго времени, форумчане.
У меня возникла проблемка. Мне необходимо макросом в Exel скопировать текст из файла Word. Текст файла примерно такой:
Акт №123
...
Таблица 1
Таблица 2

Приложения:
Сертификат качества 1 — 5 листов;
Сертификат качества 2 — 3 листа;

Сертификат качества N — 2 листа.

Представитель …..

Текст всегда находится между словами «Приложения:» и «Представитель».
Я научился обращаться к файлу Word, вытягивать в Exel данные из таблиц. А вот с поиском и копированием текста беда. А файлов как всегда +100500.

Код:
Sub Test()
Dim myWord As Object, myDoc As Object
Dim Name As String, strText1 As String, strText2 As String
 
Name = ThisWorkbook.Worksheets("Лист1").Range("A1") & ".docx"
 
On Error GoTo Instr
 
Set myWord = GetObject(, "Word.Application")
Set myDoc = myWord.Documents(Name)
 
With myDoc.Range
strText1 = «Приложения:»
strText2 = «Представитель»
????????????????????
End With
 
ThisWorkbook.Worksheets("Лист1").Range("A2").Select
ActiveCell.Paste
 
End Sub
 
Instr:
    MsgBox "Произошла ошибка: " & Err.Description
End Sub
Прошу Вас помочь с макросом.
01234567898 вне форума Ответить с цитированием
Старый 14.05.2024, 08:59   #2
shanemac51
Участник клуба
 
Аватар для shanemac51
 
Регистрация: 12.08.2010
Сообщений: 1,079
По умолчанию

Цитата:
Сообщение от 01234567898 Посмотреть сообщение
Прошу Вас помочь с макросом.
например так, хотя не ясно, что может быть между опорными словами
Код:
    Sub Test240514mm()
Dim myWord As Object, myDoc As Object
Dim sName As String, strText1 As String, strText2 As String

'' для отладки немного изменяю имя
sName = "c:\temp\" & ThisWorkbook.Worksheets("Лист2").Range("A1") & ".docx"
 On Error Resume Next
 Set myWord = GetObject(, "Word.Application")
 If Err.Number <> 0 Then
''
Set myWord = CreateObject("Word.Application")
Err.Clear
End If
On Error GoTo Instr

Set myDoc = myWord.Documents.Open(sName)
Dim j1, j2, stext
With myDoc.Range
strText1 = "Приложения:"
strText2 = "Представитель "
stext = .Text
'???????=??????????=???

j1 = InStr(stext, strText1)
j2 = InStr(stext, strText2)
Debug.Print Now, j1, j2, sName
If j1 > 0 And j1 < j2 Then
j1 = j1 + Len(strText1)
'MsgBox
Debug.Print Mid(stext, j1, j2 - j1 - 1)

 ThisWorkbook.Worksheets("Лист2").Range("b1") = Mid(stext, j1, j2 - j1 - 1)
'ThisWorkbook.Worksheets("Лист2").Range("b1").Select
'ActiveCell.Paste
myDoc.Close False
myWord.Quit False
End If
End With
Exit Sub
 
Instr:
Debug.Print Err.Number, Err.Description
'MsgBox "Произошла ошибка: " & Err.Description
End Sub
Имя-Галина== почта shanemac51@yandex.ru скайп shanemac51 c 8-15мск будни
Сфера интересов--word-excel-access-распознавание
shanemac51 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Из excel скопировать в word файле таблицу и вставить в текст письма в outlook ac1-caesar Microsoft Office Excel 1 06.01.2016 13:44
Выборочный импорт exel в exel McSim Microsoft Office Excel 3 01.03.2014 18:25
Из EXEL в Word olimpus Microsoft Office Excel 3 30.09.2009 18:55
Из EXEL в Word olimpus Microsoft Office Word 2 28.09.2009 08:00
как вставить таблицу Exel doncova1 БД в Delphi 1 19.11.2006 16:07