Delphi word поиск слова на

Mawrat

13094 / 5875 / 1706

Регистрация: 19.09.2009

Сообщений: 8,808

01.09.2013, 05:11

6

Цитата
Сообщение от vuasya
Посмотреть сообщение

мне нужно чтоб программа работала уже в готовом открытом приложении , а не создавала сама

Тогда понадобится не запускать новый экземпляр MS Word, а подключиться к уже запущенному экземпляру. В этом случае надо заменить вызов CreateOleObject() на GetActiveOleObject().
Полностью код будет выглядеть так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
uses
  ComObj;
 
{Пояснение по поиску.
Объект wdFind связан с диапазоном wdRng. При каждом вызове wdFind.Execute
поиск продолжается в том диапазоне, который определял wdRng до первого
вызова wdFind.Execute. Т. е., поиск выполняется в одном и том же диапазоне.
Но сам объект wdRng изменяется при каждом обнаружении искомого текста - он
становится равным диапазону, который охватывает этот найденный текст.}
 
{Функция ищет заданный текст aSearchText в документе MS Word aWdDoc и возвращает
ссылку на диапазон, который охватывает найденный текст.}
function FindInDoc(const aWdDoc : Variant; const aSearchText : String) : Variant;
const
  wdFindStop = 0; //Завершить поиск при достижении границы диапазона.
var
  wdRng, wdFind : Variant;
begin
  VarClear(Result);
  //Диапазон, охватывающий всё содержимое документа.
  wdRng := aWdDoc.Content;
 
  //Настройка поиска.
  wdFind := wdRng.Find;
  //wdFind.ClearFormatting;
  wdFind.Text := aSearchText;
  //True - поиск вести от начала - к концу диапазона.
  wdFind.Forward := True;
  //wdFindStop - завершить поиск при достижении границы диапазона.
  //wdFind.Wrap := wdFindStop;
 
  //Поиск текста.
  if wdFind.Execute then Result := wdRng;
end;
 
//Поиск заданного текста в документе MS Word.
procedure TForm1.Button1Click(Sender: TObject);
var
  wdApp, wdDocs, wdDoc, wdRng : Variant;
  SearchText : string;
begin
  //Искомый текст.
  SearchText := Edit1.Text;
  if SearchText = '' then begin
    MessageBox(0, 'Искомый текст не задан. Действие отменено.'
      ,'Искомый текст не задан', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
  
  //Запуск MS Word и подключение к его корневому объекту.
  try
    wdApp := GetActiveOleObject('Word.Application');
  except
    MessageBox(0, 'Нет запущенных экземпляров MS Word. Действие отменено.',
      'Отмена', MB_OK + MB_ICONWARNING + MB_APPLMODAL);
    Exit;
  end;
 
  //Подключаемся к коллекции документов.
  wdDocs := wdApp.Documents;
  //Проверяем - есть ли хотя бы один открытый документ.
  if wdDocs.Count = 0 then begin
    MessageBox(0, 'Нет ни одного открытого документа. Действие отменено.'
      ,'Отмена', MB_OK + MB_ICONWARNING + MB_APPLMODAL);
    Exit;
  end;
  //Делаем видимым окно MS Word.
  wdApp.Visible := True;
  //Подключаемся к первому документу в коллекции.
  wdDoc := wdDocs.Item(1);
  //Поиск заданного текста.
  wdRng := FindInDoc(wdDoc, SearchText);
  if VarIsClear(wdRng) then begin
    ShowMessage('Текст НЕ найден.');
    Exit;
  end;
 
  ShowMessage('Текст найден.');
 
  //Выделяем найденный текст.
  wdRng.Select;
  //Прокручиваем содержимое документа (в первом окне) таким образом, чтобы стал
  //видимым участок с найденным текстом.
  wdDoc.Windows.Item(1).ScrollIntoView(wdRng);
 
  //Можно выполнить какие-нибудь действия с найденным текстом.
  //Например, пометим найденный текст жирным красным шрифтом.
  //wdRng.Font.Bold := True;
  //wdRng.Font.Color := RGB(255, 100, 100);
end;
 
end.

Здесь происходит попытка подключения к уже запущенному экземпляру MS Word. Затем, выполняется подключение к первому из уже открытых документов. Если все эти шаги успешны, то выполняется поиск текста.

Ещё можно сделать так. Подключаемся к запущенному экземпляру MS Word. Потом, среди открытых документов ищем тот, чьё имя файла совпадает с заданным и выполняем поиск в этом документе. Имя файла пускай будет выбираться через OpenDialog.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
implementation
 
{$R *.dfm}
 
uses
  ComObj;
 
{Пояснение по поиску.
Объект wdFind связан с диапазоном wdRng. При каждом вызове wdFind.Execute
поиск продолжается в том диапазоне, который определял wdRng до первого
вызова wdFind.Execute. Т. е., поиск выполняется в одном и том же диапазоне.
Но сам объект wdRng изменяется при каждом обнаружении искомого текста - он
становится равным диапазону, который охватывает этот найденный текст.}
 
{Функция ищет заданный текст aSearchText в документе MS Word aWdDoc и возвращает
ссылку на диапазон, который охватывает найденный текст.}
function FindInDoc(const aWdDoc : Variant; const aSearchText : String) : Variant;
const
  wdFindStop = 0; //Завершить поиск при достижении границы диапазона.
var
  wdRng, wdFind : Variant;
begin
  VarClear(Result);
  //Диапазон, охватывающий всё содержимое документа.
  wdRng := aWdDoc.Content;
 
  //Настройка поиска.
  wdFind := wdRng.Find;
  //wdFind.ClearFormatting;
  wdFind.Text := aSearchText;
  //True - поиск вести от начала - к концу диапазона.
  wdFind.Forward := True;
  //wdFindStop - завершить поиск при достижении границы диапазона.
  //wdFind.Wrap := wdFindStop;
 
  //Поиск текста.
  if wdFind.Execute then Result := wdRng;
end;
 
//Поиск заданного текста в документе MS Word.
procedure TForm1.Button1Click(Sender: TObject);
var
  wdApp, wdDocs, wdDoc, wdRng : Variant;
  SearchText : string;
  i : Integer;
  Od : TOpenDialog;
begin
  //Искомый текст.
  SearchText := Edit1.Text;
  if SearchText = '' then begin
    MessageBox(0, 'Искомый текст не задан. Действие отменено.'
      ,'Искомый текст не задан', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
  //Выбор имени файла.
  Od := OpenDialog1; //OpenDialog1 уже должен быть на форме.
  if Od.InitialDir = '' then
    Od.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Od.Execute then Exit;
  if not FileExists(Od.FileName) then begin
    MessageBox(0, 'Файл с заданным именем не найден. Действие отменено.'
      ,'Файл не найден', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
 
  //Попытка подключиться к уже запущенному экземпляру MS Word.
  try
    wdApp := GetActiveOleObject('Word.Application');
  except
    MessageBox(0, 'Нет запущенных экземпляров MS Word. Действие отменено.',
      'Отмена', MB_OK + MB_ICONWARNING + MB_APPLMODAL);
    Exit;
  end;
 
  //Подключаемся к коллекции документов.
  wdDocs := wdApp.Documents;
  //Ищем документ по имени файла.
  VarClear(wdDoc);
  for i := 1 to wdDocs.Count do
    if wdDocs.Item(i).FullName = Od.FileName then begin
      wdDoc := wdDocs.Item(i);
      Break;
    end;
  if VarIsClear(wdDoc) then begin
    MessageBox(0, 'Документ не является открытым в настоящее время. Действие отменено.'
      ,'Отмена', MB_OK + MB_ICONWARNING + MB_APPLMODAL);
    Exit;
  end;
 
  //Делаем видимым окно MS Word.
  wdApp.Visible := True;
  //Поиск заданного текста.
  wdRng := FindInDoc(wdDoc, SearchText);
  if VarIsClear(wdRng) then begin
    ShowMessage('Текст НЕ найден.');
    Exit;
  end;
 
  ShowMessage('Текст найден.');
 
  //Выделяем найденный текст.
  wdRng.Select;
  //Прокручиваем содержимое документа (в первом окне) таким образом, чтобы стал
  //видимым участок с найденным текстом.
  wdDoc.Windows.Item(1).ScrollIntoView(wdRng);
 
  //Можно выполнить какие-нибудь действия с найденным текстом.
  //Например, пометим найденный текст жирным красным шрифтом.
  //wdRng.Font.Bold := True;
  //wdRng.Font.Color := RGB(255, 100, 100);
end;
 
end.



1



   Попросили меня доработать старый модуль, который генерирует клиентам компании письма в формате MS Word. Пользователи создают шаблоны, в которых расставляют названия полей, заключенные в служебные символы (например, #CONTRACT_NUM#, #FIO#, #ADDRESS#…). Программа по заданным критериям выбирает информацию о клиентах из базы и генерирует письма, находя в тексте шаблонов названия полей и заменяя их фактическими значениями.
   Если опустить все детали и различную логику, то упрощенно это выглядит так:

Var
  MSWord: OleVariant;
  i: Integer;
  q: TSDQuery;
  …
begin
  …
  MSWord := CreateOleObject(‘Word.Application’);
  MSWord.Documents.Add(‘какой то шаблон.dot’);
  For i := 0 to q.FieldCount-1 do
    MSWord.Selection.Find.Execute(FindText := ‘#’ + q.Fields[i].FieldName + ‘#’, ReplaceWith := q.Fields[i].AsString);
  …
  MSWord.ActiveDocument.SaveAs(‘письмо любимому клиенту.doc’);
  …

   Первое, с чем я столкнулся, это то, что длина значения параметра ReplaceWith не должна превышать 255 символов. Но это я обошел легко, заменив «поиск и замену текста» на «поиск и вывод текста»:

If MSWord.Selection.Find.Execute(FindText := ‘#’ + q.Fields[i].FieldName + ‘#’) then
  MSWord.Selection.TypeText(q.Fields[i].AsString);

   Вторая задачка оказалась сложнее. Внизу листа в фиксированное место необходимо было вывести фамилию и адрес получателя. Сначала я думал поместить его в нижний колонтитул, но оказалось, что письмо может быть на двух листах. Тогда ничего не оставалось, как использовать объект «заметка». Вставил «заметку». Красота! Документ генерируется, текст сдвигается, заметка остается на месте… Но радость была недолгой, т.к. поля #FIO# и #ADDRESS#, помещенные в заметку, так и остались незамененными :(
   Оказалось, что MSWord.Selection.Find.Execute ищет текст только в основной части документа, а в документе, состоящем из разных структурных элементов (заметок, колонтитулов, сносок и т.д.), поиск необходимо производить отдельно в каждом из этих элементов. Все эти структурные элементы документа являются элементами коллекции StoryRanges. Т.к. дело было к ночи, а модуль должен был быть готов к утру, я не стал разбираться, как работать со StoryRanges через OLE из Delphi, и просто добавил в тестовый шаблон письма макрос на VBA, в котором перебираются все структурные элементы активного документа, в которых ведется поиск:

Sub ReplaceText(sFindText As String, sReplaceText As String)
  Dim rngStory As Range
  For Each rngStory In ActiveDocument.StoryRanges
    With rngStory.Find
      .Text = sFindText
      .Replacement.Text = sReplaceText
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    End With
  Next rngStory
End Sub

А в программе я только написал вызов макроса:

MSWord.Application.Run(‘ReplaceText’, ‘#FIO#’, ‘Иванов Иван Иванович’);

Работает как часы :)

P.S. После окончания генерации документа, если MS Word вам больше не нужен, то не забывайте закрывать его и высвобождать память

MSWord.Quit;
MSWord := UnAssigned;

P.P.S. Для подобной задачи генерации писем в формат MS Word больше подходит не поиск и замена текста, использование полей с переменными (DocVariable) и закладок (Bookmark). А как это сделать, я расскажу в следующий раз.

I am working with our lab report system and want to automate some of the tasks. The system we use is not intuitive and uses word documents to enter data. There are several paragraphs with headings (protected headings).

I want to copy a phrase in one of the paragraphs and paste it into another paragraph using a Delphi app

GetActiveOleObject('Word.Application');

How can I use a RegEx for that. The good thing is the searchable phrases I want to copy are in uppercase while everything else is sentence case. example:

3rd paragraph heading:—> Receiver Notes <—- this is not editable in the document (protected)

  1. the specimen is received in CONTAINER OF FORMALIN at this workstation

  2. the specimen is received FRESH WITH NO FIXATIVE at this workstation

my result has to be something like:

4th paragraph heading —>Methods of Receiving <—— protected again

  1. CONTAINER OF FORMALIN <—— here is where I want to paste from the first match

  2. FRESH WITH NO FIXATIVE <—— and here the second match … etc

So my feeling is to have a delphi code to search between paragraph heading «Receiver Note» and «Methods of Receiving» for those in upper case and list them in the next paragraph.

I use delphi xe3 and I know how to use regex with other files but not in word using delphi. Any input, code snippets, examples, etc would be much appreciated!

 
Mefodiy
 
(2005-09-14 18:01)
[0]

В программе есть TEdit, в котором набирается слово на русском языке. На нажатие кнопки прописано:

 WordApp: OleVariant;
 WordApp := CreateOleObject(«Word.Application»);
 WordApp.Documents.Open(«MyWordDocument»);
 WordApp.Application.Keyboard(1049);
 WordApp.Visible := True;
………………………………………………………………..
 WordApp.Selection.Find.ClearFormatting;
 WordApp.Selection.Find.Replacement.ClearFormatting;
 WordApp.Selection.Find.Replacement.Text := «»;
 WordApp.Selection.Find.Text := MyEdit.Text;
 WordApp.Selection.Find.Forward := True;
 WordApp.Selection.Find.Wrap := 1;
 WordApp.Selection.Find.Format := False;
 WordApp.Selection.Find.MatchCase := True;
 WordApp.Selection.Find.MatchWholeWord := True;
 WordApp.Selection.Find.MatchWildcards := False;
 WordApp.Selection.Find.MatchSoundsLike := False;
 WordApp.Selection.Find.MatchAllWordForms := False;
 WordApp.Selection.Find.Execute;

Все работает без ошибок, но слово не находится, т.к. когда просматриваю через CTRL+F в Wordе, то видно, что русские буквы преобразовались в аброкадабру.

У меня Win XP. В региональных установках стоит русский язык.
В чем дело и главное что делать?
Спасибо


 
Defunct ©
 
(2005-09-15 05:33)
[1]

может попробовать так:

WS : WideString;

WS := MyEdit.Text;
WordApp.Selection.Find.Text := WS;

?


 
Mefodiy
 
(2005-09-15 08:05)
[2]

Уже пробовал. Не помогает.


 
Mefodiy
 
(2005-09-16 16:27)
[3]

Мастера, отзовитесь !!!!!!!!!!!!!!!!!!!!!!


 
lookin ©
 
(2005-09-16 16:32)
[4]

У меня Ваш код работает на ура…


 
Mefodiy
 
(2005-09-16 17:01)
[5]

С английскими буквами и числами у меня тоже работает.
  Проблема в кириллице. Насколько я понимаю в Дельфи используется  ASCII  кодировка, а в Word — Unicode. Просто я никак не могу в WordApp.Selection.Find.Text преобразовать и записать в кодировке Unicode. Не знаю возможно ли такое вообще. Использвание StringToWhideChar ничего не меняет.


 
lookin ©
 
(2005-09-16 17:10)
[6]

[5] Mefodiy   (16.09.05 17:01)

У меня с русским словом все ок…


 
Mefodiy
 
(2005-09-16 17:16)
[7]

Может быть дело в версии Word? У меня — Word 2003.


 
lookin ©
 
(2005-09-16 17:20)
[8]

[7] Mefodiy   (16.09.05 17:16)

Может быть, у меня Ворд2000 и дельфи 5… И система Win2000.


 
Mefodiy
 
(2005-09-17 10:03)
[9]

Обнаружил следующее:
Если объявить переменную
   var s: WideString;
в теле программы присвоить ей какую нибудь строку кириллицы
   s := «КИРИЛЛИЦА»;
и задать
 WordApp.Selection.Find.Text := s;
то все нормально работает.
Но если задать
   s := WordEdit.Text;
   WordApp.Selection.Find.Text := s;
опять выходит аброкадабра.
Кстати вариант
   s := WideString(WordEdit.Text);
тоже не помогает


 
Mefodiy
 
(2005-09-17 11:21)
[10]

Проблема решиласть с помощью функции:

function StringToWideString(const s: AnsiString; codePage: Word): WideString;
 var l: integer;
begin
 if s = «» then
   Result := «»
 else
 begin
   l := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PChar(@s[1]), -1, nil, 0);
   SetLength(Result, l — 1);
   if l > 1 then
     MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PChar(@s[1]),
                         -1, PWideChar(@Result[1]), l — 1);
 end;
end;

которую откопал в интернете.
Вызывать ее надо так
 WordApp.Selection.Find.Text := StringToWideString(WordEdit.Text,1251);



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

Модераторы: MetalFan

Поиск:

Ответ в темуСоздание новой темы
Создание опроса
> Поиск в Ворде фразы и вставка ее в Дельфи 

:(

   

Опции темы

Artem2005
Дата 9.1.2005, 13:43 (ссылка)
| (нет голосов)
Загрузка ... Загрузка …




Быстрая цитата

Цитата

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 16.12.2004

Репутация: нет
Всего: нет

Делаю программу по тестированию, и необходимо что-бы в дельфи вставлялся конкретный вопрос находящийся в doc файле

PM MAIL   Вверх
<Spawn>
Дата 11.1.2005, 06:34 (ссылка)
| (нет голосов)
Загрузка ... Загрузка …




Быстрая цитата

Цитата

Око кары:)
****

Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: нет
Всего: 64

Какой то странный подход. Почему не создать простенькую базу для хранения вопросов?

———————

«Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать» — Николай Безруков.

PM MAIL ICQ   Вверх
Artem2005
Дата 11.1.2005, 14:26 (ссылка)
| (нет голосов)
Загрузка ... Загрузка …




Быстрая цитата

Цитата

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 16.12.2004

Репутация: нет
Всего: нет

Дапустим я набираю вопрос в Ворде, и что дальше?

PM MAIL   Вверх
Medved
Дата 11.1.2005, 14:58 (ссылка)
| (нет голосов)
Загрузка ... Загрузка …




Быстрая цитата

Цитата

Эксперт
****

Профиль
Группа: Завсегдатай
Сообщений: 7209
Регистрация: 15.9.2002
Где: Kazakhstan, Astan a

Репутация: нет
Всего: 154

Действительно старнный подход. Логика приложения строиться в зависимости от того, в каком редакторе будут набираться вопросы. А вы мне вот скажите, как будет стоиться приложение, если вопросы будете набирать ну например в PhotoShop?

———————

http://extreme.sport-express.ru/
…и неважно сколько падал, важно сколько ты вставал…

PM MAIL WWW ICQ Skype GTalk   Вверх
Darksquall
Дата 27.1.2005, 12:38 (ссылка)
| (нет голосов)
Загрузка ... Загрузка …




Быстрая цитата

Цитата

Опытный
**

Профиль
Группа: Участник
Сообщений: 326
Регистрация: 22.1.2004
Где: Москва

Репутация: 1
Всего: 4

Хоть и странно, но отвечаю.
Положим на форму кнопку, WordApplications и WordDocument (вкладка Servers).

Пишем Функцию поиска слова.

Код

Function Tform1.Find(St:string):string;
var a, b: OleVariant;
j, ilengy: Integer;
Nashli:boolean;
begin
Nashli:=false;
       ilengy:=Length(WordDocument1.Range.Text);
       j:=0;
       repeat
               a:=j;
               b:=j+Length(st);
               if WordDocument1.Range(a,b).Text=st then Nashli:=true;
       inc(j);
       until (j>=ilengy-Length(st)) or Nashli;
       if Nashli then Find:=WordDocument1.Range(a,b).Text;
end;

И не забываем добавить функцию в класс TForm1

Теперь подключаемся к Doc файлу через компоненты со вкладки Servers, WordApplications и WordDocument.

Код

procedure TForm1.Button1Click(Sender: TObject);
var
DocName,ConfConv,ReadOnly,AddToRecFiles,Psw,PswTmp,Revert,WritePsw,WritePswTmp,
 Fmt,replace,star :OleVariant;
begin
DocName:='word1.doc';//имя файла
ConfConv:=False;
ReadOnly:=False;
AddToRecFiles:=False;
Psw:='';
PswTmp:='';
Revert:=False;
WritePsw:='';
WritePswTmp:='';
Fmt:=wdOpenFormatAuto;
replace:=wdReplaceAll;
WordApplication1.Connect;
WordApplication1.Visible:=false;//не включаем видимость Ворда
WordApplication1.Documents.Open(DocName, ConfConv, ReadOnly, AddToRecFiles,
 Psw, PswTmp, Revert, WritePsw, WritePswTmp, Fmt, EmptyParam,EmptyParam);
WordDocument1.ConnectTo(WordApplication1.ActiveDocument);
// Ищем, а затем выводим на экран
Showmessage(Form1.Find('Да здравствует Ленин!'));
//не забываем закрыть word
WordDocument1.Close;
WordApplication1.Disconnect;
end;

smile

Это сообщение отредактировал(а) Darksquall — 27.1.2005, 12:41

———————

www.bankcards.su

PM WWW ICQ   Вверх



















Ответ в темуСоздание новой темы
Создание опроса
Правила форума «Delphi: ActiveX/СОМ/CORBA»

Rrader
Girder

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) — крупнейшем в рунете сборнике материалов по Delphi
  • Вопросы по SQL и вопросы по базам данных, не связанные с Delphi, задавать здесь

Если Вам помогли, и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Rrader, Girder.

 

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: ActiveX/СОМ/CORBA | Следующая тема »

К сожалению через finddialog Вы не можете ограничить поиск только по одному столбцу, а потом Вам нужно получить значения остальных столбцов в строке, и как Вы собираетесь это сделать?:)

Если у Вас проблема с переносом данного решения в Делфи, то в честь Рождества помогу Вам примером:

Код:

В uses добавляем OleServer, COMObj

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
    Word, Excel: OleVariant;  // Указатели на приложения
    Path: OleVariant;
    Text, Needle: string;
    i, j, k, c, cc: integer;
begin
    // Основные переменные
    Path:=’C:1.doc’; // Путь к исходному документу
    Needle:=’4′; // Текст для поиска в столбце

    Word:=CreateOleObject(‘Word.Application’); // Создаем экземпляр Word’a
    Word.Visible:=false; // Показываем или скрываем окно приложения
    Excel:=CreateOleObject(‘Excel.Application’); // Создаем экземпляр Excel’a
    Excel.Visible:=true; // Показываем или скрываем окно приложения
    Excel.Workbooks.Add(EmptyParam); // Создаем пустую книгу Excel’a
    c:=0; // Сбрасываем счетчик строк в Excel (можно использовать Вставку строк, но мы будем напрямую задавать значение)
    // Открываем исходный документ
    Word.Documents.Open(Path, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
    // И далее по алгоритму, проверяем что таблицы есть в документе
    if Word.ActiveDocument.Tables.Count >= 1 then begin
        // ShowMessage(‘Найдено таблиц: ‘+IntToStr(Word.ActiveDocument.Tables.Count));
        // Циклом проходим все таблицы
        for i := 1 to Word.ActiveDocument.Tables.Count do begin
            // Проходим строки текущей таблицы в первом столбце, ищем нужный текст
            for j := 1 to Word.ActiveDocument.Tables.Item(i).Rows.Count do begin
                // Выделяем полученную ячейку
                Word.ActiveDocument.Tables.Item(i).Cell(j, 1).Select;
                // Получаем значение ячейки
                Text := Word.Selection.Text;
                // Обрезаем последние 2 символа
                Text := copy(Text,0,Length(Text)-2);
                // ShowMessage(Text);
                // Сравниваем значение первой колонки с необходимым
                if Text = Needle then begin
                    Inc(c); // Переходим на следующую строку в Excel
                    cc:=1; // Сбрасываем счетчик столбцов в Excel
                    // Добавляем в Excel значение первого столбца
                    Excel.Range[Excel.Cells[c,cc],Excel.Cells[c,cc]].Select;
                    Excel.ActiveCell.FormulaR1C1 := Text;
                    // Теперь в цикле можно получить значения остальных колонок (первую пропускаем) в данной строке
                    for k := 2 to Word.ActiveDocument.Tables.Item(i).Columns.Count do begin
                        Inc(cc);
                        // Выделяем полученную ячейку из столбца k
                        Word.ActiveDocument.Tables.Item(i).Cell(j, k).Select;
                        // Получаем значение ячейки
                        Text := Word.Selection.Text;
                        // Обрезаем последние 2 символа
                        Text := copy(Text,0,Length(Text)-2);
                        // ShowMessage(Text);
                        // Теперь можно сохранить эти данные в отдельный коллектор либо сразу же вставлять в Excel
                        Excel.Range[Excel.Cells[c,cc],Excel.Cells[c,cc]].Select;
                        Excel.ActiveCell.FormulaR1C1 := Text;
                    end;
                end;

            end;
        end;
    end else begin
        ShowMessage(‘В документе отсутствуют таблицы’);
    end;

    try
      // Закрываем документ
      Word.Quit;
      //Excel.Quit;
    except
    end;
    // Убиваем приложение
    Word:=Unassigned;
    //Excel:=Unassigned;
end;

Во вложении — весь проект + исходный вордовский документ

Успехов!

To search a whole word in a string, you can use the SearchBuf function declarated in the StrUtils.pas unit .

	function SearchBuf(Buf: PAnsiChar; BufLen: Integer; SelStart: Integer; SelLength: Integer; SearchString: AnsiString; Options: TStringSearchOptions): PAnsiChar; overload;

Buf is the text buffer to search.
BufLen is the length, in chars, of Buf.
SelStart is the first character of the search when Options indicates a backward search (does not include soDown). The first character in Buf has position 0.
SelLength is the number of characters after SelStart that the search begins when Options indicates a forward search (includes soDown).
SearchString is the string to find in Buf.
Options determines whether the search runs forward (soDown) or backward from SelStart or SelStart+SelLength, whether the search is case sensitive (soMatchCase), and whether the matching string must be a whole word (soWholeWord).

If SearchBuf finds a match, it returns a pointer to the first character of the matching string in Buf. If it does not find a match, SearchBuf returns nil.

Now using this function we can construct a new  function which will return true or false if find a word in a string.

function ExistWordInString(const AString:PWideChar;const ASearchString:string;ASearchOptions: TStringSearchOptions): Boolean;
var
  Size : Integer;
begin
  Size:=StrLen(aString);
  result := SearchBuf(AString, Size, 0, 0, ASearchString, ASearchOptions)<>nil;
end;

Use it this way
Case-insensitive

  ExistWordInString('Go Delphi Go','Delphi',[soWholeWord,soDown]); //Return True
  ExistWordInString('Go Delphi, Go','Delphi',[soWholeWord,soDown]); //Return True
  ExistWordInString('Go ,Delphi, Go','Delphi',[soWholeWord,soDown]); //Return True
  ExistWordInString('Go DELPHI Go','Delphi',[soWholeWord,soDown]); //Return True

Case sensitive

  ExistWordInString('Go Delphi Go','Delphi',[soWholeWord,soDown,soMatchCase]); //Return True
  ExistWordInString('Go DELPHI Go','Delphi',[soWholeWord,soDown,soMatchCase]); //Return False
  ExistWordInString('Go DelphI Go','Delphi',[soWholeWord,soDown,soMatchCase]); //Return False

Like this post? Please share to your friends:
  • Delphi word на передний план
  • Delphi word межстрочный интервал
  • Delphi word копирование текста
  • Delphi word как найти текст
  • Delphi word как закрыть word