📄 unitexcel.pas
字号:
unit UnitExcel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,comobj,Outlook2000, Excel2000, OleServer, StdCtrls,GridsEh,
DBGridEh,UnitPageCut, Db, DBTables;
type
TExcelFrm = class(TForm)
Button5: TButton;
Button8: TButton;
ExcelApplication1: TExcelApplication;
ExcelWorksheet1: TExcelWorksheet;
ExcelWorkbook1: TExcelWorkbook;
Button10: TButton;
Button11: TButton;
procedure Button5Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
private
{ Private declarations }
//excel: OleVariant;
public
{ Public declarations }
procedure CopyDbDataToExcel(Args: array of const);
procedure DataToExcel;
procedure PersonExcel(condition:string);
procedure FillCell(row:integer;column:integer;StrFont:string);
procedure RangeCell(row:integer;column:integer;nr:integer;nc:integer;StrField:string);
end;
var
ExcelFrm: TExcelFrm;
implementation
{$R *.dfm}
uses UnitDataModule;
//first
procedure TExcelFrm.Button5Click(Sender: TObject);
begin
try
self.ExcelWorkbook1.Save(0);
//self.ExcelWorkbook1.SaveCopyAs('pp.xls',0);
ExcelWorkSheet1.Disconnect;
ExcelWorkBook1.Disconnect;
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
self.Close;
except
exit;
end;
end;
{procedure TExcelFrm.Button7Click(Sender: TObject);
var
//WorkBook, Sheet: Variant;
// Col, Row,iRow,iCol,i : Integer;
//strpath:string;
begin
try
Excel:=CreateOleObject('Excel.Application');
excel.visible:=true;
//WorkBook:=CreateOleobject('Excel.Sheet');
except
application.Messagebox('无法打开Xls文件，请确认已经安装EXCEL.','',
mb_OK+mb_IconStop);
Exit;
end;
end;}
procedure TExcelFrm.Button8Click(Sender: TObject);
begin
self.PersonExcel('');
End;
procedure TExcelFrm.RangeCell(row:integer;column:integer;nr:integer;nc:integer;StrField:string);
var range:Variant;
begin
Range:=ExcelApplication1.Range[ExcelWorksheet1.Cells.Item[row,column],ExcelWorksheet1.Cells.Item[row+nr,column+nc]];
Range.Merge;
Range.FormulaR1C1:=StrField;
Range.HorizontalAlignment := xlGeneral;
Range.VerticalAlignment := xlBottom;
Range.WrapText := False;
Range.Orientation := 0;
Range.AddIndent := False;
Range.IndentLevel := 0;
Range.ShrinkToFit := False;
Range.ReadingOrder := xlContext;
Range.MergeCells := True;
Range.Font.Name := '宋体';
Range.Font.FontStyle := '常规';
Range.Font.Size := 10;
end;
procedure TExcelFrm.FillCell(row:integer;column:integer;StrFont:string);
var cell:Variant;
begin
cell:=ExcelWorksheet1.Cells.Item[row,column];
cell.FormulaR1C1:=StrFont;
cell.Font.Bold:=True;
cell.Font.Name := '宋体';
cell.Font.FontStyle := '常规';
cell.Font.Size := 10;
cell.Font.Strikethrough := False;
cell.Font.Superscript := False;
cell.Font.Subscript := False;
cell.Font.OutlineFont := False;
cell.Font.Shadow := False;
cell.Font.Underline := xlUnderlineStyleNone;
cell.Font.ColorIndex := xlAutomatic;
end;
procedure TExcelFrm.PersonExcel(condition:string);
var
row,column:integer;
strfield,strpath,tmpstr:string;
range:variant;
FWorksheet,FPicture:OleVariant;
begin
Screen.Cursor := crHourGlass;
Try
ExcelApplication1.Connect;
Except
//MessageDlg('Excel may not be installed',mtError,[mbOk],0);
Screen.Cursor := crDefault;
Abort;
Exit;
End;
Try
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='ExcelApplication';
ExcelApplication1.Workbooks.Add(Null,0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
ExcelWorksheet1.Activate;
//---------------------设置标题--------------------------
Range:=ExcelApplication1.Range[ExcelWorksheet1.Cells.Item[1,1], ExcelWorksheet1.cells.Item[2,10]];
Range.Merge;//合并
//Range.unmerge //拆分单元格
Range.FormulaR1C1:='个人信息';//合并后写入文本
Range.HorizontalAlignment:= xlCenter;// 文本水平居中方式
Range.VerticalAlignment:= xlCenter;//文本垂直居中方式
Range.WrapText:=true;//文本自动换行
//Range.Borders.LineStyle:=1;//加边框
//nge.Interior.ColorIndex:=39;//填充颜色为淡紫色
Range.Font.name:='隶书';//字体
Range.Font.Color:=clBlue;//字体颜色
Range.Font.Bold:= True;
Range.Font.Size:=20;
//--------------------------------------------------------------
if DataModule1.ADOQuery2.Active=false then
exit;
DataModule1.ADOQuery2.First;
row:=1;
// while not (DataModule1.ADOQuery2.Eof) do
// begin
column:=0;
row:=row+1;
self.FillCell(row+1,column+1,'姓名');
self.FillCell(row+2,column+1,'移动电话');
self.FillCell(row+3,column+1,'公司名称');
self.FillCell(row+4,column+1,'公司电话');
self.FillCell(row+5,column+1,'传真');
self.FillCell(row+6,column+1,'办公地点');
self.FillCell(row+7,column+1,'email');
self.FillCell(row+8,column+1,'公司Email');
self.FillCell(row+9,column+1,'地点');
self.FillCell(row+10,column+1,'备注');
self.FillCell(row+11,column+1,'开户行');
self.FillCell(row+12,column+1,'帐号');
self.FillCell(row+13,column+1,'税号');
self.FillCell(row+14,column+1,'备注1');
self.FillCell(row+15,column+1,'备注2');
self.FillCell(row+16,column+1,'备注3');
self.FillCell(row+1,column+4,'年龄');
self.FillCell(row+2,column+4,'性别');
self.FillCell(row+3,column+4,'职位');
self.FillCell(row+4,column+4,'家庭电话');
self.FillCell(row+5,column+4,'国家/地区');
self.FillCell(row+6,column+4,'行业');
strpath:=extractfilepath(application.exename);
strfield:=DataModule1.ADOQuery2.FieldByName('photo').AsString;
Try
if strfield<>'' then
begin
tmpstr:=strpath+'personphoto\'+strfield;
self.RangeCell(row+1,column+7,5,2,tmpstr);
FWorksheet:=ExcelApplication1.ActiveSheet;
FPicture:=FWorksheet.Pictures.Insert(strpath+'\personphoto\'+strfield);
FPicture.Left:=330;
FPicture.Top:=35;
FPicture.width:=150;
FPicture.height:=80;
FPicture:=null;
end else
begin
self.RangeCell(row+1,column+7,5,2,'没有图片');
end;
except
self.RangeCell(row+1,column+7,5,2,'图片无法显示');
end;
strfield:=DataModule1.ADOQuery2.FieldByName('pname').AsString;
self.RangeCell(row+1,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('age').AsString;;
self.RangeCell(row+1,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('handtel').AsString;
self.RangeCell(row+2,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('sex').AsString;
self.RangeCell(row+2,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('company').AsString;
self.RangeCell(row+3,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('duty').AsString;
self.RangeCell(row+3,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('ctel').AsString;
self.RangeCell(row+4,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('hometel').AsString;
self.RangeCell(row+4,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('cfax').AsString;
self.RangeCell(row+5,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('area').AsString;
self.RangeCell(row+5,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('office').AsString;
self.RangeCell(row+6,column+2,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('industry').AsString;
self.RangeCell(row+6,column+5,0,1,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('email').AsString;
self.RangeCell(row+7,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('cemail').AsString;
self.RangeCell(row+8,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('address').AsString;
self.RangeCell(row+9,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('memo1').AsString;
self.RangeCell(row+10,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('cbank').AsString;
self.RangeCell(row+11,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('ctax').AsString;
self.RangeCell(row+12,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('ccode').AsString;
self.RangeCell(row+13,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('memo2').AsString;
self.RangeCell(row+14,column+2,0,7,strfield);
strfield:=DataModule1.ADOQuery2.FieldByName('memo3').AsString;
self.RangeCell(row+15,column+2,0,7,strfield);
DataModule1.ADOQuery2.Next;
// end;
ExcelApplication1.Visible[0]:=True;
Except
//showMessage('error');
Screen.Cursor := crDefault;
exit;
End;
Screen.Cursor := crDefault;
end;
procedure TExcelFrm.CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;
for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGridEH(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGridEH(Args[I].VObject).Name];
if not TDBGridEH(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Sheet.Cells[1,5] :='我的名片';
TDBGridEH(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGridEH(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[3, iCount + 1] :=
TDBGridEH(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 3;
while not TDBGridEH(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGridEH(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGridEH(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGridEH(Args[I].VObject).DataSource.DataSet.Next;
end;
XlApp.Visible := True;
end;
Screen.Cursor := crDefault;
end;
{------------------------------DataToExcel-------------------------------------}
procedure TExcelFrm.DataToExcel;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
strfield:string;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook :=1;
XLApp.WorkBooks[1].WorkSheets[1].Name := 'mysheet';
Sheet := XLApp.Workbooks[1].WorkSheets['mysheet'];
if not DataModule1.ADOQuery2.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Sheet.Cells[1,1] := 'aaaaaa';
Sheet.Cells[1,2] :='cccccccc' ;
strfield:=DataModule1.ADOQuery2.FieldByName('photo').AsString;
sheet.Pictures.Insert(extractfilepath(application.exename)+'personphoto\p2.bmp');
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
procedure TExcelFrm.Button10Click(Sender: TObject);
begin
ExcelWorksheet1.PrintOut;
end;
procedure TExcelFrm.Button11Click(Sender: TObject);
//var range:Variant;
begin
{Application.Left = 49
Application.Top = 249.25
Range("I3:L9").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Application.Left = 217
Application.Top = 229
Range("I3:L9").Select
ActiveSheet.Pictures.Insert("F:\aspstacks\p2.gif").Select
Application.Left = 190.75
Application.Top = 76
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A12").Select
Application.Left = 300.25
Application.Top = 174.25}
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -