如何使用Delphi在Openoffice文档的页眉/页脚/表中搜索文本标签并替换为图像 [英] How to Search text tags and replace with Image in Header/Footer/Table of Openoffice Document using Delphi

问题描述

我有打开的Office模板文档，需要在其中搜索[CHART = 100]之类的标签，并用PC上某个文件夹中的Image文件替换它.

I have open office template documents where i need to search for tags like [CHART=100] and replace it with a Image file reside in some folder at PC.

我正在使用上一个问题中提到的方法. 如何使用Delphi在OpenOffice文档中插入图像.

I am using approach mentioned in my previous question. How to insert image in OpenOffice Document using Delphi.

Procedure ReplaceTextTagsWithImage(sFileTobeReplaced,ImageFile:string);
  var
    ServiceManager: Variant;
    Desktop: Variant;
    Document: Variant;
    NoParams : Variant;
    FileReplace: Variant;
    FileSearch : Variant;
    Txt : Variant;
    TextCursor : Variant;
    FileParams: Variant;
    Graphic : Variant;
    FileProperty,Imageproperty: Variant;
    afileurl,gurl : string;
    xinterface,xTextRange,curTextView : variant;
    ppoint : variant;
    SearchDescriptor,found : Variant;
    IdNumber : Integer;
    sNumber : string;
    Bitmaps : Variant;

    function CreateProperty(const AName: AnsiString; const AValue: Variant): Variant;
    begin
      Result := ServiceManager.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
      Result.Name := AName;
      Result.Value := AValue;
    end;

  begin
    Try
      ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
      Desktop := ServiceManager.createInstance('com.sun.star.frame.Desktop');
      FileParams := VarArrayCreate([0, 0], varVariant);
      FileParams[0] := CreateProperty('Hidden',True); {hide Document}
      afileurl := 'file:///'+sFileTobeReplaced;
      Document := Desktop.loadComponentFromURL(afileurl, '_blank', 0, FileParams);
      Txt := Document.getText;
      TextCursor := Txt.createTextCursor;
      SearchDescriptor := Document.createSearchDescriptor;

      SearchDescriptor.setSearchString('[CHART=[0-9].*]');
      SearchDescriptor.SearchRegularExpression := True;
      Found := Document.findFirst(SearchDescriptor);
      Bitmaps := Document.createInstance('com.sun.star.drawing.BitmapTable');
      While Not (VarIsNull(Found) or VarIsEmpty(Found) or VarIsType(Found,varUnknown)) do
      begin
         sNumber := String(Found.getString);
         sNumber := copy(String(Found.getString), Length('<CHART=')+1 );
         sNumber := copy(Trim(sNumber),1,length(sNumber)-1);
         Found.setString('');
         Graphic := Document.createInstance('com.sun.star.text.GraphicObject');
         gurl := 'file:///'+ImageFile;
         if not Bitmaps.hasbyname(sNumber+'_Image') then
            Bitmaps.insertByName(sNumber+'_Image', gurl);
         Graphic.GraphicURL := Bitmaps.getByName(sNumber+'_Image');
         Graphic.AnchorType := 1; {com.sun.star.text.TextContentAnchorType.AS_CHARACTER;}
         Graphic.Width := 6000;
         Graphic.Height := 8000;
         TextCursor.gotoRange(Found, False);
         Txt.insertTextContent(TextCursor, Graphic, False);
         Found := Document.findNext(Found.getEnd, SearchDescriptor);
      end;
      FileParams[0] := CreateProperty('Overwrite',True);
      Document.storeAsURL(afileurl, FileParams);
      Document.Close(True);
      Try
        Desktop.Terminate;
      except
      end;
    Finally
      Document := Unassigned;
      Desktop := Unassigned;
      ServiceManager := Unassigned;
    end;
  end;


  procedure TForm6.Button3Click(Sender: TObject);
  var
    sFileToBeReplaced : String;
    sImageFile : String;
  begin
    sFileToBeReplaced := edOOFile.Text;
    sImageFile := edImageFile.Text;
    Try
      ReplaceTextTagsWithImage(sFileToBeReplaced,sImageFile);
      ShowMessage('Success');
    Except
      on E: Exception do
      ShowMessage(E.Message);

    End;
  end;

当标签文本不在页眉/页脚/表中时，此代码可以正常工作，但是，如果我在页眉/页脚/表中定义标签，则会在

This code works fine when Tag text is not in header/footer/table, however if i define tag in header/footer/table i get error "com.sun.star.uno.RuntimeException:" at

TextCursor.gotoRange(Found, False); 

我不确定如何在搜索和替换中引用范围.

I am not sure how to refer ranges in search and replace.

请建议如何实现.

推荐答案

标题，表等都有自己的文本对象，因此主文档的文本对象将不起作用.而是从Found获取文本对象和光标.

Headers, tables and so on have their own text object, so the text object of the main document will not work. Instead, get the text object and cursor from Found.

此外，从正则表达式中删除.以匹配多个数字而不是多个数字.并且方括号必须是文字.

Also, remove . from the regular expression to match multiple digits instead of multiple of anything. And the brackets must be literal.

这里正在工作的基本代码.

Here is working Basic code.

Sub ReplaceTextTagsWithImage
    Document = ThisComponent
    Bitmaps = Document.createInstance("com.sun.star.drawing.BitmapTable")
    ImageFile = "C:/google_wht.gif"
    SearchDescriptor = Document.createSearchDescriptor()
    SearchDescriptor.setSearchString("\[CHART=[0-9]*\]")
    SearchDescriptor.SearchRegularExpression = True
    Found = Document.findFirst(SearchDescriptor)
    Do While Not IsNull(Found)
        TextCursor = Found.getText().createTextCursor()
        TextCursor.gotoRange(Found, False)
        Graphic = Document.createInstance("com.sun.star.text.GraphicObject")
        gurl = "file:///" & ImageFile
        gname = sNumber & "_Image"
        if Not Bitmaps.hasbyname(gname) Then
            Bitmaps.insertByName(gname, gurl)
        End If
        Graphic.GraphicURL = Bitmaps.getByName(gname)
        Graphic.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
        Graphic.Width = 6000
        Graphic.Height = 8000
        TextCursor.getText().insertTextContent(TextCursor, Graphic, False)
        Found = ThisComponent.findNext( Found.End, SearchDescriptor)
    Loop
End Sub

这篇关于如何使用Delphi在Openoffice文档的页眉/页脚/表中搜索文本标签并替换为图像的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！