【搞定】请问怎样在word文档中查找正则表达式？**

shiyg

在delphi中可以这样:
MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);
在x3中怎么实现呢?

lixy

unit MainForm;

interface

uses
  Business.System, Business.Forms,System;

type
  TMainForm = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    BitBtn1: TBitBtn;
   
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Edit3: TEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
   
    procedure Button2Click(Sender: TObject);
  private
    {private declarations}
  public
        FWord , docsbject;
        FApp,FDocs ispatchHelper;
    {public declarations}
  end;

implementation


procedure TMainForm.Button1Click(Sender: TObject);
var
  lFileName: String;
begin
  if OpenDialog1.Execute then
  begin
    lFileName := OpenDialog1.FileName;
    FWord := ComObj.CreateOleObject('Word.Application');
    FApp := DispatchHelper.Create(FWord);
    FApp.PropertyPut('Visible', [True]);

    docs := FApp.PropertyGet('Documents',  []);
    FDocs := DispatchHelper.Create(docs);

    FDocs.InvokeMethod('Open', [lFileName]);
    end;
end;

procedure TMainForm.BitBtn1Click(Sender: TObject);
var
  lAw: DispatchHelper;
  awbject;
begin
  aw:= FApp.PropertyGet('ActiveWindow',  []);
   lAw:=  DispatchHelper.Create(aw);
// lAw := DispatchHelper.Create(FApp.PropertyGet('ActiveWindow', []));
  lAw.InvokeMethod('Close', []);

  fapp.InvokeMethod('quit', []);

  (aw as idisposable).Dispose;
  (docs as idisposable).Dispose;
  (fword as idisposable).Dispose;

   //FWord. InvokeMethod('Quit', []); //   Quit(savechanges,originalformat,routeDocument);

end;



  //通配符

procedure TMainForm.Button2Click(Sender: TObject);
var
  lSelection, lFind, lFindText,lMatchWildcards: DispatchHelper;
begin
  lSelection := DispatchHelper.Create(FApp.PropertyGet('Selection', []));
  lFind :=  DispatchHelper.Create(lSelection.PropertyGet('Find', []));

    lFind.InvokeMethod('Execute', ['10{1,3}', False, False, true, false, False, True, false, False,'justep',
    2, False, False, False, False]);

   // Function Execute([FindText], [MatchCase], [MatchWholeWord], [MatchWildcards], [MatchSoundsLike], [MatchAllWordForms], [Forward], [Wrap], [Format], [ReplaceWith], [Replace], [MatchKashida], [MatchDiacritics], [MatchAlefHamza], [MatchControl]) As Boolean
  //  Word.Find 的成员

end;

end.

shiyg

谢谢！
如果我想获取MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);中被{}括起来的内容，应该怎么做呢？
因为我想根据{}内容确定要替换的值

lixy

word的通配符我不太会用，上面的通配符我也是查word帮助弄出来的。
楼主只要在word里面测试成功的通配符，放到第一个参数就可以了

shiyg

我的需求是：查找word中的{*},取得*的内容（也就是字段名）后，取数据库中字段的值，再来替换。
你这句lFind.InvokeMethod('Execute', ['10{1,3}', False, False, true, false, False, True, false, False,'justep',
    2, False, False, False, False]);是明确了替换的内容。不太一样。
我就想怎么获得返回值。

lixy

楼主把您测试成功的delphi代码贴上来，或者附件打包上来。

shiyg

{ 先分析以 大括号 括起来的文字 }
  MyWord.Selection.SetRange(Start:=0, End:=0);
  MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);//找到通配符
  while MyWord.Selection.Find.Found do//如果找到了
  begin
    DocText := MyWord.Selection.Text;//取得找到的字符串
    DocText := Copy(DocText, 2, Length(DocText) - 2);//脱去{}

    EndText.Clear;
    MacroToData(DocText, EndText);//这是个函数，根据*的内容取数据库中的值
    ReplaceText := '';
    for jLoop := 0 to EndText.Count - 1 do
      ReplaceText := ReplaceText + EndText.Strings[jLoop] + #15;  // 用 #15 先代替回车
    if ReplaceText <> '' then
      ReplaceText := Copy(ReplaceText, 0, Length(ReplaceText) - 1); // 把最后一个 #15 去掉

    MyWord.Selection.Text := ReplaceText;//用数据库的值替换通配符

    MyWord.Selection.SetRange(Start:=0, End:=0);
    MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);//查找下一个通配符
  end;

shiyg

关键是：找到通配符，判断是否找到，取得找到的字符串这个不知道怎么实现

lixy

请贴个全的吧。myword怎么声明的都没贴上来。

shiyg

procedure TWordReport.OpenWithData(FileName: String; Data: OleVariant; Param: String = '');
var
  MyWord: OleVariant;
  WordDoc: OleVariant;
  iLoop, jLoop: integer;
  DocText, ReplaceText: WideString;
  EndText: TStringList;
  MyTable: Variant;
  MyRange: Variant;
  iCol, iRow: integer;
  sParam, sValue: TStringList;
  sSQL: String;
begin
  FromData.Data := Data;
  EndText := TStringList.Create;

  m_Param := Param;

  { 分解自定义参数和值 }
  sParam := Split(GetStr(Param, ';', 0));
  sValue := Split(GetStr(Param, ';', 1), #15);

  { 新建一个 WORD 文档 }
  MyWord := GetOrCreateObject('Word.Application');
  WordDoc := MyWord.Documents.Add(FileName, NewTemplate:=False);
  //MyWord.Visible := true;

  try
  { 替换参数 }
  if sParam.Count = sValue.Count then
    for iLoop := 0 to sParam.Count - 1 do
    begin
      MyWord.Selection.Find.Text := '$' + sParam.Strings[iLoop];
      MyWord.Selection.Find.Replacement.Text := sValue.Strings[iLoop];
      MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
    end;

  { 替换一些宏 }
  MyWord.Selection.Find.Text := '$Now';
  MyWord.Selection.Find.Replacement.Text := DateTimeToStr(Now);
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '$Date';
  MyWord.Selection.Find.Replacement.Text := DateToStr(Date);
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '$Time';
  MyWord.Selection.Find.Replacement.Text := TimeToStr(Time);
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '$UserDate';
  MyWord.Selection.Find.Replacement.Text := Static.Date;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '$Company';
  MyWord.Selection.Find.Replacement.Text := CurUser.Company;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[usercode]';
  MyWord.Selection.Find.Replacement.Text := CurUser.usercode;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[username]';
  MyWord.Selection.Find.Replacement.Text := CurUser.UserName;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[deptno]';
  MyWord.Selection.Find.Replacement.Text := CurUser.deptno;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[datapopedom]';
  MyWord.Selection.Find.Replacement.Text := CurUser.datapopedom;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[科目表名]';
  MyWord.Selection.Find.Replacement.Text := '财务_科目' + SysCode.CurFinYear;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[curfinyear]';
  MyWord.Selection.Find.Replacement.Text := SysCode.CurFinYear;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);
  MyWord.Selection.Find.Text := '[curfinmonth]';
  MyWord.Selection.Find.Replacement.Text := SysCode.CurFinMonth;
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, forward:= True, Wrap := wdFindContinue, MatchWildcards := false);

  { 先分析以 <- 和 -> 括起来的文字 }
  MyWord.Selection.SetRange(Start:=0, End:=0);
  MyWord.Selection.Find.Execute(FindText := '[<]-*-[>]', MatchWildcards := true);
  while MyWord.Selection.Find.Found do
  begin
    DocText := MyWord.Selection.Text;
    DocText := Copy(DocText, 3, Length(DocText) - 4);

    EndText.Clear;
    MacroToData(DocText, EndText);
    ReplaceText := '';
    for jLoop := 0 to EndText.Count - 1 do
      ReplaceText := ReplaceText + EndText.Strings[jLoop] + #15;  // 用 #15 先代替回车
    if ReplaceText <> '' then
      ReplaceText := Copy(ReplaceText, 0, Length(ReplaceText) - 1); // 把最后一个 #15 去掉

    MyWord.Selection.Text := ReplaceText;

    MyWord.Selection.SetRange(Start:=0, End:=0);
    MyWord.Selection.Find.Execute(FindText := '[<]-*-[>]', MatchWildcards := true);
  end;

  MyWord.Selection.Find.Text := #15;
  MyWord.Selection.Find.Replacement.Text := '^p';
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, Forward:= True, Wrap := wdFindContinue, MatchWildcards := false);

  { 先分析以 大括号 括起来的文字 }
  MyWord.Selection.SetRange(Start:=0, End:=0);
  MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);
  while MyWord.Selection.Find.Found do
  begin
    DocText := MyWord.Selection.Text;
    DocText := Copy(DocText, 2, Length(DocText) - 2);

    EndText.Clear;
    MacroToData(DocText, EndText);
    ReplaceText := '';
    for jLoop := 0 to EndText.Count - 1 do
      ReplaceText := ReplaceText + EndText.Strings[jLoop] + #15;  // 用 #15 先代替回车
    if ReplaceText <> '' then
      ReplaceText := Copy(ReplaceText, 0, Length(ReplaceText) - 1); // 把最后一个 #15 去掉

    MyWord.Selection.Text := ReplaceText;

    MyWord.Selection.SetRange(Start:=0, End:=0);
    MyWord.Selection.Find.Execute(FindText := '[{]*[}]', MatchWildcards := true);
  end;

  MyWord.Selection.Find.Text := #15;
  MyWord.Selection.Find.Replacement.Text := '^p';
  MyWord.Selection.Find.Execute(Replace:=wdReplaceAll, Forward:= True, Wrap := wdFindContinue, MatchWildcards := false);

  {**
   * 处理用 [SQLNOTITLE] 和 [/SQLNOTITLE] 括起来的，没有表头的
   * 加的比较急 2004.10.14
   *}
  MyWord.Selection.SetRange(Start:=0, End:=0);
  MyWord.Selection.Find.Execute(FindText := '[[]ASQLNOTITLE[]]*[[]/ASQLNOTITLE[]]', MatchWildcards := true);
  DocText := MyWord.Selection.Text;
  while MyWord.Selection.Find.Found do
  begin
    DocText := Copy(DocText, 14, Length(DocText) - 27);
    sSQL := DocText;

    { 本想在此函数最开始的时候就替换这些参数，
      但自做主张的 WORD 总是把 ' 换成 “，太讨厌了 }
    if sParam.Count = sValue.Count then
      for jLoop := 0 to sParam.Count - 1 do
        ReplaceString(sSQL, '$SQL' + sParam.Strings[jLoop], sValue.Strings[jLoop], false);
    with dmMain.DA.NewCDS('WordReportSQL', sSQL) do
    begin
      if (FieldCount = 1) and (RecordCount = 1) then
        MyWord.Selection.Text := Fields[0].AsString
      else
      begin
        if RecordCount = 0 then
          MyWord.Selection.Text := ''
        else
        begin
          MyRange := MyWord.Selection.Range;
          MyTable := WordDoc.Tables.Add (Range:= MyRange, NumRows:=RecordCount, NumColumns:=FieldCount);
          First;
          iRow := 1;
          while not Eof do
          begin
            for iCol := 0 to FieldCount - 1 do
            begin
              MyTable.Cell(iRow, iCol + 1).Range.InsertAfter(Fields[iCol].AsString);
            end;
            Next;
            inc(iRow);
          end;
        end;
      end;
    end;
    dmMain.DA.DeleteCDS('WordReportSQL');
    MyWord.Selection.SetRange(Start:=0, End:=0);
    MyWord.Selection.Find.Execute(FindText := '[[]ASQLNOTITLE[]]*[[]/ASQLNOTITLE[]]', MatchWildcards := true);
    DocText := MyWord.Selection.Text;
  end;

  { 处理用 [SQL] 和 [/SQL] 括起来的 }
  MyWord.Selection.SetRange(Start:=0, End:=0);
  MyWord.Selection.Find.Execute(FindText := '[[]SQL[]]*[[]/SQL[]]', MatchWildcards := true);
  DocText := MyWord.Selection.Text;
  while MyWord.Selection.Find.Found do
  begin
    DocText := Copy(DocText, 6, Length(DocText) - 11);
    sSQL := DocText;

    { 本想在此函数最开始的时候就替换这些参数，
      但自做主张的 WORD 总是把 ' 换成 “，太讨厌了 }
    if sParam.Count = sValue.Count then
      for jLoop := 0 to sParam.Count - 1 do
        ReplaceString(sSQL, '$SQL' + sParam.Strings[jLoop], sValue.Strings[jLoop], false);
    with dmMain.DA.NewCDS('WordReportSQL', sSQL) do
    begin
      if (FieldCount = 1) and (RecordCount = 1) then
        MyWord.Selection.Text := Fields[0].AsString
      else
      begin
        if RecordCount = 0 then
          MyWord.Selection.Text := ''
        else
        begin
          MyRange := MyWord.Selection.Range;
          MyTable := WordDoc.Tables.Add (Range:= MyRange, NumRows:=RecordCount + 1, NumColumns:=FieldCount);
          First;
          for iCol := 0 to FieldCount - 1 do
          begin
            MyTable.Cell(1, iCol + 1).Range.InsertAfter(Fields[iCol].FieldName);
          end;

          iRow := 2;
          while not Eof do
          begin
            for iCol := 0 to FieldCount - 1 do
            begin
              MyTable.Cell(iRow, iCol + 1).Range.InsertAfter(Fields[iCol].AsString);
            end;
            Next;
            inc(iRow);
          end;
        end;
      end;
    end;
    dmMain.DA.DeleteCDS('WordReportSQL');
    MyWord.Selection.SetRange(Start:=0, End:=0);
    MyWord.Selection.Find.Execute(FindText := '[[]SQL[]]*[[]/SQL[]]', MatchWildcards := true);
    DocText := MyWord.Selection.Text;
  end;
  finally
    MyWord.Visible := true;
    MyWord := Unassigned;
  end;
end;