2019年8月31日 星期六

[研究][Delphi] 取得 PowerPoint ( .pptx , .ppt )中所有文字 (使用 PowerPoint COM Object)

[研究][Delphi] 取得 PowerPoint ( .pptx , .ppt )中所有文字 (使用 PowerPoint COM Object)

2019-08-31

實際測試於 Embarcadero Delphi.10.3.1 v26.0 ( 2019 ) + Office 2019

Office 必須是 商業版本 ( Viewer 無用)，啟用期限未到的，或 已經啟用的。( 逾期未啟用好像也不行)。

uses 要加上 ComObj;



下面實際測試僅能用於 .pptx，但有時 .ppt 會失敗。
PptApp.Presentations.Open(sName, False, False, True);
會出現
Project XXX.exe raised exception class EOleException with message '無法指出的錯誤'.
目前測試，被開啟的 .ppt 和本程式在相同目錄，就可能發生；不同目錄，目前都正常。
不管編譯目標是產生 32 位元 or 64 bits 的程式，執行時都可能發生問題。
.pptx 則似乎都正常。

Unit1.pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  comobj;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ReadPPt(sName: string): string;
var
  n,m,i,j: integer;
  PptApp: OleVariant;
begin
  try
    PptApp := CreateOleObject('PowerPoint.Application');
    PptApp.Visible := true;

     PptApp.Presentations.Open(sName);
    n := PptApp.ActiveWindow.Presentation.Slides.Count;

     for i:=1 to n do
    begin
      m := PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.Count;
      for j:=1 to m do
      begin
        If PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.item(j).HasTextFrame Then
          result:=result+PptApp.ActiveWindow.Presentation.Slides.item(i).Shapes.item(j).TextFrame.TextRange.Text +#$D#$A;
      end;
    end;
  finally
    PptApp.ActiveWindow.Presentation.Saved := true;
    PptApp.ActiveWindow.Close;
    PptApp.Quit;
    PptApp := null;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := ReadPPT('C:\Temp\Test.pptx');
end;
end.

(完)

相關

Presentations.Open method (PowerPoint) | Microsoft Docs
https://docs.microsoft.com/en-us/office/vba/api/powerpoint.presentations.open

張貼者： 於

沒有留言:

張貼留言

訂閱： 張貼留言 (Atom)