Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年06月22日] [更新 2013年12月02日] ワード操作フォームEx
   
ワード操作フォームEx   参考コード類
帳票台紙をヘッダ部に挿入して調整
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro + Word 2010







帳票台紙をヘッダ部に挿入して調整


帳票類の台紙はヘッダ・フッタ部に挿入すると,変更されずにすみます.帳票の台紙は元の帳票をスキャナーでスキャンした画像を用いることもできますが,ワードで作成することもできます.いろいろなオブジェクトで作成した文書を [全て選択] し,グループ化してメタファイルで保存したりすれば,面倒ですが体裁のいい画像ができます.また,官公庁等が配布しているワードの帳票類の原稿も利用できます.

このテストプログラムは,作成した画像をヘッダ・フッタ部に挿入し,その位置やサイズを微調整できるようにしています.実際に帳票に合わせるためには,縦横比は変更しないと思いますが,テストですので,縦横比も変更できるようにしています.


図1
挿入する元の帳票画像例
図2
調整用の TSpinEdit も配置
図3
実行例

リスト1
ヘッダ・フッタ部に画像を挿入して位置とサイズを調整
unit WordTestForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, plWordEx, StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls, Spin;

type
  TplWordFormEx2 = class(TplWordFormEx)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    SpinEdit2: TSpinEdit;
    Label2: TLabel;
    SpinEdit3: TSpinEdit;
    Label3: TLabel;
    SpinEdit4: TSpinEdit;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    AShape : Twdf2000Shape;
  public
    { Public 宣言 }
  end;

var
  plWordFormEx2: TplWordFormEx2;

implementation

uses Word2000;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TplWordFormEx2.FormShow(Sender: TObject);
begin
  //表示する文書の指定
  wdfFileFullPath := '白紙文書.doc';

  //元のOnShowを実行
  inherited;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TplWordFormEx2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //保存したことにしてしまう
  if wdfFileOpened then wdfWordDoc.Saved := True;

  //元の処理を実行
  inherited;
end;

//=============================================================================
//  ヘッダフッタ部に図を挿入
//  AShape(Twdf2000Shape)はグローバル変数(Button2でも使用するので)
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  AHeaderFooter     : Word2000.HeaderFooter;
  pFalse            : OleVariant;
  pFileName         : WideString;
  pLinkToFile       : OleVariant;
  pSaveWithDocument : OleVariant;
  pLeft             : OleVariant;
  pTop              : OleVariant;
  pWidth            : OleVariant;
  pHeight           : OleVariant;
  pAnchor           : OleVariant;
begin
  pFileName         := ExtractFilePath(Application.ExeName) + '法定調書合計表.emf';
  pLinkToFile       := False;                           //挿入した図のリンク
  pSaveWithDocument := True;                            //図を文書と共に保存
  pLeft             := 0;                               //左端位置
  pTop              := 0;                               //上端位置
  pWidth            := wdfWordDoc.PageSetup.PageWidth;  //用紙サイズ(pt)
  pHeight           := wdfWordDoc.PageSetup.PageHeight; //用紙サイズ(pt)
  pAnchor           := EmptyParam;                      //アンカー位置

  //奇数と偶数頁でヘッダフッタ部を変えない
  pFalse := False;
  wdfWordDoc.PageSetup.OddAndEvenPagesHeaderFooter := pFalse;
  //すべての頁のヘッダフッタを同じとする.pTrueだと最初の頁のみ別
  wdfWordDoc.PageSetup.DifferentFirstPageHeaderFooter := pFalse;

  //ヘッダフッタオブジェクトを取得
  AHeaderFooter := wdfWordDoc.Sections.Item(1).Headers.Item(wdHeaderFooterPrimary);
  //ヘッダフッタ部にワードアートを挿入
  //Word2007ではこの処理が非常に遅い
  AShape := AHeaderFooter.Shapes.AddPicture(pFileName,
                                  pLinkToFile,
                                  pSaveWithDocument,
                                  pLeft,
                                  pTop,
                                  pWidth,
                                  pHeight,
                                  pAnchor);

  //図の縦横比は維持しない(位置とサイズを調整したいので)
  AShape.LockAspectRatio := pFalse;

  //Word2002以上の場合,上のコードのままだと段落基準になってしまうので
  //ページ基準を設定して改めて再配置
  //Word2002のVBAのヘルプではAddPictureの最後の引数を省略するとページ
  //基準で配置されるとあるが,実際にはならないのでおそらくバグであろう
  AShape.RelativeHorizontalPosition := wdRelativeHorizontalPositionPage;
  AShape.RelativeVerticalPosition   := wdRelativeVerticalPositionPage;
  AShape.Left := pLeft;
  AShape.Top  := pTop;

  //0.1mm単位の値を各SpinEditに表示
  SpinEdit1.Value := Trunc(wdfWordApp.PointsToMillimeters(pLeft)   * 10);
  SpinEdit2.Value := Trunc(wdfWordApp.PointsToMillimeters(pTop)    * 10);
  SpinEdit3.Value := Trunc(wdfWordApp.PointsToMillimeters(pWidth)  * 10);
  SpinEdit4.Value := Trunc(wdfWordApp.PointsToMillimeters(pHeight) * 10);
end;

//=============================================================================
//  SpinEditの値に基づいて図の位置とサイズを調整
//=============================================================================
procedure TplWordFormEx2.Button2Click(Sender: TObject);
var
  ALeft   : Single;
  ATop    : Single;
  AWidth  : Single;
  AHeight : Single;
begin
  ALeft         := wdfWordApp.MillimetersToPoints(SpinEdit1.Value div 10);
  AShape.Left   := ALeft;

  ATop          := wdfWordApp.MillimetersToPoints(SpinEdit2.Value div 10);
  AShape.Top    := ATop;

  AWidth        := wdfWordApp.MillimetersToPoints(SpinEdit3.Value div 10);
  AShape.Width  := AWidth;

  AHeight       := wdfWordApp.MillimetersToPoints(SpinEdit4.Value div 10);
  AShape.Height := AHeight;
end;

end.