[研究][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
