请教(50分)

  • 主题发起人 主题发起人 意林
  • 开始时间 开始时间

意林

Unregistered / Unconfirmed
GUEST, unregistred user!
在delphi中如何控制Excel页眉中的字体、大小?
 
xlApp : TExcelApplication
xlBook : TExcelWorkbook;
xlSheet : TExcelSheet;

//设置sheet1的页眉
procedure TForm1.Button7Click(Sender: TObject);
begin
xlApp.Connect;
xlApp.Visible[0] := True;
xlBook.ConnectTo(xlApp.Workbooks.Open('E:/temp.xls',NULL,false,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,0));
xlSheet.ConnectTo(xlBook.Sheets[1] as _WorkSheet);
//缺省字号,字体为 隶书,常规
xlSheet.PageSetup.LeftHeader := '&"隶书,常规"左边的页眉';
//字号20,字体为隶书,常规
xlSheet.PageSetup.CenterHeader := '&"隶书,常规"&20中间的页眉';
//字号10,字体为楷体_GB2312,加粗
xlSheet.PageSetup.RightHeader := '&"楷体_GB2312,加粗 倾斜"&10右边的页眉';
end;
 
{*******************************************************}
{ }
{ Arm Software TArmExcel Package }
{ TArmExcel Unit }
{ }
{ Copyright (C) 2000 Arm Software }
{ 作者 :宫雨 }
{ 地址:dht@www.bjpeu.edu.cn }
{*******************************************************}
{TArmExcel 用EXCEL做报表,
1。设置纸张、页眉页脚、网格线
2。导出数据集的数据-(对部分字段)求和
3。可以选择工作表,打印预览
4。像STRINGGrid一样使用CellS属性
5。有ONExportProgress事件与用户交互
2000-09-14 修改代码结构}

unit ArmExcel;

interface

uses
Windows,comobj,Messages,SysUtils,db,Classes,Forms,armconst;
type
//用于页眉页脚
TReportTitle=class(TPersistent)
private
FLeft:string;
FCenter:string;
FRight:string;
public
published
property Left:string read Fleft write Fleft;
property Center:string read Fcenter write Fcenter;
property Right:string read FRight write FRight;
end;
//export
TExportOptions=class(TPersistent)
private
FShowSum:boolean;
FDataset:Tdataset;
FDrawGrid:boolean;
FSaveFile:boolean;
FShowExcel:boolean;
FShowFieldName:boolean;
FSaveFileName:string;
FCellColOffset,FCellRowOffset:integer;
FSumFields:TStrings;
procedure SetSumFields(const Value: TStrings);
public
constructor create;
destructor Destroy;override;
published
//user interface
property DrawGrid:boolean read FDrawGrid write FDrawGrid;
property ShowFieldName:boolean read FShowFieldName write FShowFieldName;
property SaveFileName:string read FSaveFileName write FSaveFileName;
//dataset
property CellColOffset:integer read FCellColOffset write FCellColOffset;//数据集横向偏移量
property CellRowOffset:integer read FCellRowOffset write FCellRowOffset;//数据集竖直偏移量
property SaveFile:boolean read FSaveFile write FSaveFile;
property Dataset:Tdataset read Fdataset write Fdataset; //数据集
property ShowSum:boolean read FShowSum write FShowSum;
property ShowExcel:boolean read FShowExcel write FShowExcel;
property SumFields:TStrings read FSumFields write SetSumFields;
end;
//表格线
TGridBound=class(TPersistent)
private
ftop:integer;
fbottom:integer;
fleft:integer;
fright:integer;
public
published
property top:integer read FTop write Ftop;
property bottom:integer read fbottom write fbottom;
property left:integer read Fleft write fleft;
property Right:integer read FRight write fright;
end;
type
TProgressEvent = procedure(Info: string; Count, Total: Integer) of object;
//
TArmExcel = class(TComponent)
private
msexcel:variant;
wbook:Variant;
wsheet:variant;
FFilename:string;
FPrintTitleRows:STRING;//表头
FHeader,FFooter:TReportTitle;
FExportOptions:TExportOptions;
FGrid:TGridBound;
FShowGrid: boolean;
FDirectPreview:boolean;
Factivesheet:string;
FPagerSize:TPaperSize;
FshowWindows:boolean;
Fclose:boolean;
FOnExportProgress:TProgressEvent;
procedure DrawGrid;
procedure ClearGrid;
procedure PageSetup;
function GetCells(ARow,ACol: Integer): olevariant;
procedure SetCells(ARow,ACol: Integer; const Value: olevariant);
procedure CaculateSum;
procedure SetActiveSheet(const Value: string);
procedure SetShowGrid(const Value: boolean);
procedure SetPrintTitleRows(const Value: STRING);
procedure SetPagerSize(const Value: TPaperSize);

protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
procedure CreateInstance;
procedure FreeExcelInstance;
procedure ExportData;
procedure ShowExcelWindow;
property Cells[ACol,ARow:Integer]: olevariant read GetCells write SetCells;
published
property FileName:string read FFileName write FFileName;//模板文件名
property Header:TReportTitle read Fheader write Fheader;//页眉
property Footer:TReportTitle read FFooter write FFooter; //页脚
property ExportOptions:TExportOptions read FExportOptions write FExportOptions;
property ShowGrid:boolean read FShowGrid write SetShowGrid ; //显示网格
property GridBound:TGridBound read FGrid write FGrid;//网格边界
PROPERTY PrintTitleRows:STRING READ FPrintTitleRows WRITE SetPrintTitleRows;//每页表头
property ActiveSheet:string Read FActiveSheet write SetActiveSheet;//当前工作表
property PaperSize:TPaperSize read FPagerSize write SetPagerSize ; //纸张大小
property DirectPreview:boolean read FDirectPreview write FDirectPreview; //直接预览
property CloseExcelWhenAppClose:boolean read Fclose write Fclose;//当程序关闭时关闭Excel
property ShowWindowAfterOpen:boolean read FshowWindows write FshowWindows;
//event
property OnExportProgress:TProgressEvent read FOnExportProgress write FOnExportProgress;//进度显示

end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('宫雨', [TArmExcel]);
end;

{ TArmExcel }

constructor TArmExcel.create(aowner: TComponent);
begin
inherited Create(AOwner);
Fheader:=TReportTitle.create;
FFooter:=TReportTitle.create;
Fgrid:=TGridBound.create;
FExportOptions:=TExportOptions.Create;
FShowGrid:=False;
FClose:=True;
FDirectPreview:=false;
FPagerSize:=xlPaperA4;
end;

procedure TArmExcel.createinstance;
begin
MsExcel:= CreateOleObject('Excel.Application');
WBook:=MsExcel.Application;
if (filename<>'') and (FileExists(FileName)) then
wbook.workbooks.Open(filename)
else
wbook.workbooks.add;
if activesheet<>'' then
wbook.Sheets[activesheet].Select;
WSheet:=WBook.ActiveSheet;
if showgrid then
DrawGrid;
PageSetup;
if FshowWindows then
ShowExcelWindow;
end;

destructor TArmExcel.Destroy;
begin
if fclose then
freeEXCElinstance;
Fheader.Free;
FFooter.Free;
Fgrid.Free;
FExportOptions.Free;
inherited Destroy;
end;

procedure TArmExcel.drawgrid;
VAR
ATXT:STRING;
begin
if Varisempty(wsheet) then
exit;
WITH GridBound DO
BEGIN
ATXT:=chr(64+left)+inttostr(top)+':'+chr(64+RIGHT)+inttostr(bottom);
WSheet.Range[ATXT].Borders[xlDiagonalDown].LineStyle:= xlNone;
WSheet.Range[ATXT].Borders[xlDiagonalUp].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeLeft].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeTop].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeBottom].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeRight].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideVertical].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideHorizontal].LineStyle:=xlContinuous;
END;
end;

procedure TArmExcel.FreeExcelInstance;
begin
if not varisempty(wbook) then
begin
Wbook.DisplayAlerts:=False;
Wbook.quit;
WBook:= UnAssigned;
end;
end;

function TArmExcel.GetCells(ARow,ACol: Integer): olevariant;
begin
if not varisempty(wsheet) then
result:=wsheet.cells[arow,acol].value;
end;

procedure TArmExcel.PageSetup;
begin
WSheet.PageSetup.PrintTitleRows:=PrintTitleRows;
if Header.left<>'' then
wsheet.pagesetup.LeftHeader:=Header.left;
if Header.right<>'' then
wsheet.pagesetup.RightHeader:=Header.RIGHT;
if Header.Center<>'' then
wsheet.pagesetup.CenterHeader:=Header.CENTER;
if FOOTER.left<>'' then
wsheet.pagesetup.LeftFooter:=Footer.left;
if FOOTER.right<>'' then
wsheet.pagesetup.RightFooter:=Footer.RIGHT;
if FOOTER.center<>'' then
wsheet.pagesetup.CenterFooter:=Footer.CENTER;
wsheet.pagesetup.PaperSize:=PaperSizeMetrics[PaperSize];
if (DirectPreview) then
wbook.ActiveWindow.SelectedSheets.PrintPreview;
end;

procedure TArmExcel.SetCells(ARow,ACol:Integer; const Value: olevariant);
begin
if not varisempty(wsheet) then
wsheet.cells[AROw,ACol].value:=value;
end;

procedure TArmExcel.ShowExcelWindow;
begin
WBook.Visible:=True;
end;

procedure TArmExcel.ExportData;
const
info='进度:%D/%D';
var
i,j,index:integer;
SavePlace: TBookmark;
begin
if ExportOptions.dataset=nil then
exit;
if not ExportOptions.dataset.active then
exit;
with ExportOptions.dataset,ExportOptions do
begin
SavePlace := GetBookmark;
disablecontrols;
first;
i:=1;
if ShowFieldName then
begin
for j:=0 to fieldcount-1 do
wsheet.cells[1+CellColOffset,j+1+CellRowOffset]:=fields[j].DisplayLabel;
i:=i+1;
end;
while not eof do
begin
for j:=0 to fieldcount-1 do
if fields[j].datatype in [Ftfloat,ftSmallint,ftInteger,ftWord,ftCurrency] then
wsheet.cells[i+CellColOffset,j+1+CellRowOffset]:=fields[j].asfloat
else
wsheet.cells[i+CellColOffset,j+1+CellRowOffset]:=fields[j].asstring;
next;
if Assigned(OnExportProgress) then
if ShowFieldName then
OnExportProgress(format(info,[i,RecordCount+1]),I,RecordCount)
else
OnExportProgress(format(info,[i,RecordCount]),I,RecordCount);
Application.ProcessMessages;
i:=i+1;
end;
if ShowSum and (Sumfields.Count<>0) then
begin
for j:=0 to fieldcount-1 do
if Tstringlist(sumfields).find(fields[j].FieldName,index) then
begin
if fields[j].datatype in [Ftfloat,ftSmallint,ftInteger,ftWord,ftCurrency] then
if ShowFieldName then
wsheet.Cells[i+CellColOffset,j+1+CellRowOffset]:='=sum('+chr(j+CellColOffset+65)
+inttostr(CellRowOffset+2)+':'+chr(j+CellColOffset+65)+inttostr(CellRowOffset+1+recordcount)+')'
else
wsheet.Cells[i+CellColOffset,j+1+CellRowOffset]:='=sum('+chr(j+CellColOffset+65)
+inttostr(CellRowOffset+1)+':'+chr(j+CellColOffset+65)+inttostr(CellRowOffset+recordcount)+')';
end;
end;
GotoBookmark(SavePlace);
FreeBookmark(SavePlace);
enablecontrols;
if DrawGrid then
begin
GridBound.top:=CellRowOffset+1;
if ShowFieldName then
GridBound.bottom:=RecordCount+CellRowOffset+1
else
GridBound.bottom:=RecordCount+CellRowOffset;
GridBound.left:=1+CellColOffset;
GridBound.Right:=CellColOffset+FieldCount;
self.DrawGrid;
end;
if SaveFile and (SaveFileName<>'')then
wbook.activeworkbook.saveas(SaveFileName);
if ShowExcel then
ShowExcelWindow;
end;
end;
procedure TArmExcel.CaculateSum;
begin
with ExportOptions,ExportOptions.Dataset do
begin
end;
end;

procedure TArmExcel.SetActiveSheet(const Value: string);
begin
FActiveSheet:= Value;
if (FActiveSheet<>'') and (Not Varisempty(wbook)) then
wbook.Sheets[activesheet].Select;
end;

procedure TArmExcel.SetShowGrid(const Value: boolean);
begin
FShowGrid := Value;
if FShowGrid then
DrawGrid
else
ClearGrid;
end;

procedure TArmExcel.ClearGrid;
VAR
ATXT:STRING;
begin
if Varisempty(wsheet) then
exit;
WITH GridBound DO
BEGIN
ATXT:=chr(64+left)+inttostr(top)+':'+chr(64+RIGHT)+inttostr(bottom);
WSheet.Range[ATXT].Borders[xlDiagonalDown].LineStyle:= xlNone;
WSheet.Range[ATXT].Borders[xlDiagonalUp].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeLeft].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeTop].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeBottom].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeRight].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlInsideVertical].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlInsideHorizontal].LineStyle:=xlNone;
END;
end;

procedure TArmExcel.SetPrintTitleRows(const Value: STRING);
begin
FPrintTitleRows := Value;
if not Varisempty(wsheet) then
WSheet.PageSetup.PrintTitleRows:=PrintTitleRows;
end;

procedure TArmExcel.SetPagerSize(const Value: TPaperSize);
begin
FPagerSize := Value;
if not Varisempty(wsheet) then
wsheet.pagesetup.PaperSize:=PaperSizeMetrics[PaperSize];
end;

{ TExportOptions }


constructor TExportOptions.create;
begin
inherited create;
FSumFields:=TStringlist.Create;
end;

destructor TExportOptions.Destroy;
begin
FSumFields.Free;
inherited Destroy;
end;

procedure TExportOptions.SetSumFields(const Value: TStrings);
begin
if Value = FSumFields then
Exit;
FSumFields.Assign(Value);
end;

end.
 
再贴一下页眉和页脚的格式代码,然后看看上面的代码就应该清楚了吧.
格式代码 说明
-----------------
&L 后续字符左对齐。
&C 后续字符居中。
&R 后续字符右对齐。
&E 打开或关闭打印双下划线功能。
&X 打开或关闭打印上标字符功能。
&Y 打开或关闭打印下标字符功能。
&B 打开或关闭打印加粗字符功能。
&I 打开或关闭打印倾斜字符功能。
&U 打开或关闭打印下划线功能。
&S 打开或关闭打印删除线功能。
&D 打印当前日期。
&T 打印当前时间。
&F 打印文档名称。
&A 打印工作簿标签名称。
&P 打印页号。
&P+数字 打印页号加上指定数字。
&P-数字 打印页号减去指定数字。
& 打印单个和号。
&"fontname" 以指定的字体打印后续字符。确保包含了双引号。
&nn 以指定的字体大小打印后续字符。用一个 2 位数字指定以磅为单位的大小。
&N 打印文档的总页数。
 
我的代码是这样:
XL:=CreateOLEObject('Excel.Application');
XL.visible:=true;
XL.Caption:='案件列表';
XL.WorkBooks.Add;
XL.worksheets[1].activate;
XL.ActiveSheet.PageSetup.CenterHeader:='&''隶书,加粗''&14交案件列表';
XL.ActiveSheet.PageSetup.Orientation := xlLandscape;
但显示出来的页眉只有大小正确,字体却没变,这是何故?
页眉显示:
隶书,加粗'交案件列表
 
上面不是写了吗
[blue]&"fontname" 以指定的字体打印后续字符。确保包含了双引号[/blue]
是双引号,不是两个单引号.
 
谢谢两位
 
后退
顶部