Microsoft Word

[Meta777]

Hallo,

hier nun eine mögliche Lösung. Funzt auch soweit. Nur werden Kopf-/Fußzeilen nicht mit gespeichert.
Vielleicht geht das auch einfacher aber es funzt....

Aufgerufen wird die funktion z.B. so:

Delphi-Quellcode:

var
  WordApplication : TWordApplication;
begin
  WordApplication := TWordApplication.Create(Self);
  ...
  SaveDocAsJPG(WordApplication.ActiveDocument, 'C:\');

Delphi-Quellcode:

procedure TForm1.SaveDocAsJPG(Document: _Document; SaveTo: String);
//Bilder werden nummeriert in "SaveTo" abgelegt. Also das erste ist z.B. "C:\1.jpg" wenn SaveTo "C:\" ist
var
  pic: Graphics.TPicture;
  bmp: Graphics.TBitmap;
  jpg: jpeg.TJPEGImage;
  SaveDir: String;
  curPage, i: Integer;
  SelStart, SelEnd: OleVariant;
begin
  try
    pic := TPicture.Create;
    bmp := Graphics.TBitmap.Create;
    jpg := TJPEGImage.Create;
    curPage := 1;
    SelStart := 0;
    SaveDir := IncludeTrailingPathDelimiter(SaveTo);
    try
      for i := 1 to Document.Sentences.Count do begin
        if (Document.Sentences.Item(i).Information[wdActiveEndPageNumber] > curPage) OR
           (i = Document.Sentences.Count) then begin// auch prüfen ob am Ende des Document angekommen! Denn der "Rest" muss auch gespeichert werden
          SelEnd := Document.Sentences.Item(i).End_;//Ende des aktuellen Satzes
          Document.Range(SelStart, SelEnd).CopyAsPicture;//Auswahl kopieren. (MetaFile)
          pic.Assign(Clipboard);// Zwisichenablage dem TPicture zuweisen.

          //Graphic nach TBitmap convertieren (in DP gefunden)
          bmp.PixelFormat := pf24bit;
          bmp.Width := pic.Graphic.Width;
          bmp.Height := pic.Graphic.Height;
          bmp.Canvas.Draw(0,0, pic.Graphic);

          //bmp dem jpg zuweisen und komprimieren und speichern
          jpg.Assign(bmp);
          jpg.CompressionQuality := 90;
          jpg.Compress;
          jpg.SaveToFile(SaveDir+IntToStr(curPage)+'.jpg');
//          bmp.SaveToFile('C:\test'+IntToStr(curPage)+'.bmp');//falls das bmp nötig wär...

          Inc(curPage);//nächste Seite
          SelStart := SelEnd;//Auswahlbegin der nächsten Seite ist das Ende der Aktuellen

          //aufräumen
          bmp.Dormant;
          bmp.FreeImage;
          bmp.ReleaseHandle;
        end;
      end;
    finally
      pic.Free;
      bmp.Free;
      jpg.Free;
    end;
  except
    on e:Exception do begin
      ShowMessage('Fehler beim Speichern des Worddokument als Bilddatei!'+
                    #13#10+e.Message+#13#10+e.ClassName)
    end;
  end;
end;