VPF::Как найти все вхождения строки в тексте MSWord?

ZVano

Дата 14.2.2010, 13:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

Нужно произвести поиск строки формата "\<\#*\>" в документе MSWord и получить массив вхождений (Region или начальная_конечная позиции, без разницы).

Такой способ ищет только в основном тексте документа, но не ищет в колонтитулах и надписях.

Код


type
  TParamsFind2000 = record
    _FindText, _MatchCase, _MatchWholeWord, _MatchWildcards, _MatchSoundsLike, _MatchAllWordForms, _Forward, _Wrap,
      _Format, _ReplaceWith, _Replace, _MatchKashida, _MatchDiacritics, _MatchAlefHamza, _MatchControl: OleVariant;
  end;
var
  vFindPar:TParamsFind2000;
begin
  with vParFind do begin
    _FindText := '\<#*\>'; // Искомый текст
    _MatchCase := False; // Регистрозависимый?
    _MatchWholeWord := False;
    _MatchWildcards := True;
    _MatchSoundsLike := False;
    _MatchAllWordForms := False;
    _Forward := True; // Вперед
    // _Wrap := wdFindContinue;
    _Wrap := wdFindStop;
    _Format := False;
    _ReplaceWith := '';
    _Replace := wdReplaceNone; // Способ замены (Не заменять|Все|Один)
    _MatchKashida := EmptyParam;
    _MatchDiacritics := EmptyParam;
    _MatchAlefHamza := EmptyParam;
    _MatchControl := EmptyParam;
    
   while fWApp.Selection.Find.Execute(
      _FindText, _MatchCase, _MatchWholeWord, _MatchWildcards, _MatchSoundsLike,
      _MatchAllWordForms, _Forward, _Wrap, _Format, _ReplaceWith, _Replace,
      _MatchKashida, _MatchDiacritics, _MatchAlefHamza, _MatchControl)
    do begin
      vTagText := fWApp.Selection.Text;
      vTagPosBeg := fWApp.Selection.Range.Start;
      vTagPosEnd := fWApp.Selection.Range.End_;
      if Assigned(fOnTagFound) then
        fOnTagFound(vTagText, vTagPosBeg);
      TagPosAdd(vTagText, vTagPosBeg, vTagPosEnd);
    end;
  end;
end;

Надписи можно перебрать используя свойство Shapes.

Код


var
  vCnrShapes:Integer;
  vCurShapeIndex:OleVariant;
  vCurShape:Shape;
begin
  for vCnrShapes := 1 to fWDoc.Shapes.Count do begin
    vCurShapeIndex := vCnrShapes;
    vCurShape := fWDoc.Shapes.Item(vCurShapeIndex);
    if (vCurShape.type_ <> msoTextBox{17})
      then Continue;
    //...текущий Shape является надписью 
  end;
end;

Но, как оказалось, надписи могут быть заключены в объект "Полотно" с типом 20. Тут я жестоко обломался. Информации никакой.
У шейпа может быть TextFrame у которого есть диапазон TextRange, а может и не быть.
Если он есть, то с ним можно работать как с обычным объектом Region.

Код


var
  vFindRange, vCurRange :Region;
begin
    vFindRange := fWDoc.Shapes.Item(vCurShapeIndex).TextFrame.TextRange;
    vCurRange := vFindRange;
   while vCurRange.Find.Execute(
      _FindText, _MatchCase, _MatchWholeWord, _MatchWildcards, _MatchSoundsLike,
      _MatchAllWordForms, _Forward, _Wrap, _Format, _ReplaceWith, _Replace,
      _MatchKashida, _MatchDiacritics, _MatchAlefHamza, _MatchControl)
    do begin
        if (vCurRange.Start >= vFindRange.Start)and(vCurRange.End_ <=  vFindRange.End_) then begin
          vCurRange.Select;
          fLog.Lines.Add(fWApp.Selection.Range.Text);
        end;        
    end;
end;

Если нет, то при попытке обращения возникает исключение.

Как быть? Как достучаться до дочерних объектов? Или есть другой способ?

Кстати, сам Word ищет все вхождения легко и непринужденно. При этом получается такой вот макрос:

Код


Sub Макрос1()
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<\#*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
    ...
    ActiveWindow.Panes(2).Activate
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<\#*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
End Sub

В приаттаченом файле шаблон документа, который нужно обработать.

Это сообщение отредактировал(а) ZVano - 15.2.2010, 13:54

Присоединённый файл ( Кол-во скачиваний: 2 )

inscriptions.zip 5,44 Kb

--------------------

НЕ ФЛУДИМ. Пользуемся кнопками "+" или "-" для выражения своего отношения к теме или сообщению.
Гуглим "Как правильно задавать вопросы"

ZVano

Дата 15.2.2010, 15:45 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

Частичное решение (поиск в тексте и надписях, которые не запулены в контейнер):

Код



procedure TForm1.ParseRange(_FindRange:Range);
type
  TParamsFind2000 = record
    _FindText, _MatchCase, _MatchWholeWord, _MatchWildcards, _MatchSoundsLike, _MatchAllWordForms, _Forward, _Wrap,
      _Format, _ReplaceWith, _Replace, _MatchKashida, _MatchDiacritics, _MatchAlefHamza, _MatchControl: OleVariant;
  end;
var
  vParFind :TParamsFind2000;
  vCurRange:Range;
begin
  {$REGION 'Параметры'}
  with vParFind do begin
    //_FindText := GetRegExprText(fKeyMarks.Prefix) + '*' + GetRegExprText(fKeyMarks.Postfix); // Искомый текст '\<#*\>'
    _FindText := '\<\#*\>';
    _MatchCase := False; // Регистрозависимый?
    _MatchWholeWord := False;
    _MatchWildcards := True;
    _MatchSoundsLike := False;
    _MatchAllWordForms := False;
    _Forward := True; // Вперед
    // _Wrap := wdFindContinue;
    _Wrap := wdFindStop;
    _Format := False;
    _ReplaceWith := '';
    _Replace := wdReplaceNone; // Способ замены (Не заменять|Все|Один)
    _MatchKashida := EmptyParam;
    _MatchDiacritics := EmptyParam;
    _MatchAlefHamza := EmptyParam;
    _MatchControl := EmptyParam;
  end;
  {$ENDREGION}
  
  fLog.Lines.Add(_FindRange.Text);
  {$REGION 'Парсим'}
  vCurRange := _FindRange;
  with vParFind do begin
    while vCurRange.Find.Execute(
      _FindText, _MatchCase, _MatchWholeWord, _MatchWildcards, _MatchSoundsLike,
      _MatchAllWordForms, _Forward, _Wrap, _Format, _ReplaceWith, _Replace,
      _MatchKashida, _MatchDiacritics, _MatchAlefHamza, _MatchControl)
    do begin
      if (vCurRange.Start >= _FindRange.Start)and(vCurRange.End_ <=  _FindRange.End_) then begin
        fLog.Lines.Add(vCurRange.Text);
      end;
    end;
  end;
  {$ENDREGION}
end;


procedure TForm1.fBtnFindClick(Sender: TObject);
const
  msoTextBox=17;
var
  vParFind:TParamsFind2000;
  vCnrShapes:Integer;
  vCurShapeIndex:OleVariant;
  vCurShape:Shape;
  vCurShapeRange:ShapeRange;
  vFindRange, vCurShapeTextRange:Range;
begin
  d :=wdStory;
  fWApp.Selection.HomeKey(d, EmptyParam);
  {$REGION 'Параметры поиска'}

  {$REGION 'Поиск в основном тексте'}
  vFindRange := fWApp.ActiveDocument.Content;
  ParseRange(vFindRange);
  {$ENDREGION}
  {$REGION 'Поиск в надписях'}
  for vCnrShapes := 1 to fWDoc.Shapes.Count do begin
    vCurShapeIndex := vCnrShapes;
    vCurShape := fWDoc.Shapes.Item(vCurShapeIndex);
    try
      vCurShapeTextRange := vCurShape.TextFrame.TextRange;
    except
      Continue;
    end;
    vCurShapeRange := fWDoc.Shapes.Range(vCurShapeIndex);
    vCurShapeTextRange.Select;
    vFindRange := fWApp.Selection.Range;
    ParseRange(vFindRange);
  end;
  {$ENDREGION}
end;

Это сообщение отредактировал(а) ZVano - 15.2.2010, 15:50

--------------------

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