在
在世寻欢
Unregistered / Unconfirmed
GUEST, unregistred user!
在使用Delphi的TExcelApplication系列组件操作Excel时遇到数字格式的问题。原数据是百分比格式,拷贝到其他单元格后显示成了小数(保留一位,比如原来的8%显示成了0.1)。这个怎么解决?设置NumberFormatLocal或NumberFormat都没用!代码如下。
unit SararyU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Excel2000,StdCtrls, ExtCtrls,ShellAPI, ComCtrls;
type
TFrmMain = class(TForm)
edtTargetPath: TLabeledEdit;
edtSrcPath: TLabeledEdit;
btnGO: TButton;
edtTemplateFile: TLabeledEdit;
StatusBar: TStatusBar;
procedure edtSrcPathDblClick(Sender: TObject);
procedure edtTargetPathDblClick(Sender: TObject);
procedure btnGOClick(Sender: TObject);
procedure edtTemplateFileDblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edtSrcPathExit(Sender: TObject);
//procedure WndProc(var Message:TMessage);override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.edtSrcPathDblClick(Sender: TObject);
var
dlgOpen:TOpenDialog;
begin
dlgOpen:=TOpenDialog.Create(Application);
try
with dlgOpen do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofPathMustExist in Options) then
Options:=Options+[ofPathMustExist];
if not (ofFileMustExist in Options) then
Options:=Options+[ofFileMustExist];
if Execute then
edtSrcPath.Text:=FileName;
end;
except
dlgOpen.Free;
end;
end;
procedure TFrmMain.edtTargetPathDblClick(Sender: TObject);
var
dlgSave:TSaveDialog;
begin
dlgSave:=TSaveDialog.Create(Application);
with dlgSave do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofCreatePrompt in Options) then
Options:=Options+[ofCreatePrompt];
if not (ofOverWritePrompt in Options) then
Options:=Options+[ofOverWritePrompt];
if Execute then
edtTargetPath.Text:=ChangeFileExt(FileName,'.xls');
if FileExists(FileName) then DeleteFile(FileName);
end;
end;
procedure TFrmMain.btnGOClick(Sender: TObject);
var
ExcelApp:TExcelApplication;
//ExcelApp:OleVariant;
SrcBook,TargetBook:TExcelWorkBook;
SrcSheet,TargetSheet:TExcelWorkSheet;
RowHgt:BYTE;
I,Idx,nIdx,nCurRow:Integer;
SheetCount:BYTE;
bFlag:Boolean;
J,FontSize:BYTE;
//Temp:Real;
begin
btnGo.Enabled:=False;
edtSrcpath.ReadOnly:=True;
edtTargetPath.ReadOnly:=True;
edtTemplateFile.ReadOnly:=True;
ExcelApp:=TExcelApplication.Create(nil);
SrcBook:=TExcelWorkBook.Create(nil);
TargetBook:=TExcelWorkBook.Create(nil);
SrcSheet:=TExcelWorkSheet.Create(nil);
TargetSheet:=TExcelWorkSheet.Create(nil);
try
try
ExcelApp.Connect;
ExcelApp.Caption:='工资条批量打印';
ExcelApp.Visible[0]:=True;
SrcBook.ConnectTo(ExcelApp.Workbooks.Add(edtSrcPath.Text,0));
Targetbook.ConnectTo(ExcelApp.Workbooks.Add(edtTemplateFile.Text,0));
TargetSheet.ConnectTo(TargetBook.Worksheets[1] as _WorkSheet);
//ShowMessage(TargetSheet.Range['K4','K4'].NumberFormat);
RowHgt:=TargetSheet.Range['B3','B3'].RowHeight;
FontSize:=TargetSheet.Range['B2','B2'].Font.Size;
//TargetBook.Activate;
SheetCount:=SrcBook.Worksheets.Count;
StatusBar.Panels[5].Text:='正在处理,请稍候';
for Idx:=1 to SheetCount do
begin
//if Idx<>3 then Continue;
SrcSheet.Disconnect;
TargetSheet.Disconnect;
SrcSheet.ConnectTo(SrcBook.Worksheets[Idx] as _WorkSheet);
TargetSheet.ConnectTo(TargetBook.Worksheets[Idx] as _Worksheet);
TargetSheet.Name:=SrcSheet.Name;
I:=0;
nCurRow:=1;
bFlag:=True;
while bFlag do
begin
StatusBar.Panels[1].Text:=SrcSheet.Cells.Item[I*33+2,2];
Self.Update;
Application.ProcessMessages;
for nIdx:=I*33+6 to I*33+30 do
begin
if Length(Trim(SrcSheet.Cells.Item[nIdx,1]))>=4 then
begin
if nCurRow>1 then
TargetSheet.Range['A1','X3'].Copy(TargetSheet.Range['A'+IntToStr(nCurRow),'A'+IntToStr(nCurRow)]);
TargetSheet.Range['B'+IntToStr(nCurRow+2),'B'+IntToStr(nCurRow+2)].RowHeight:=RowHgt;
//TargetSheet.Range['B'+IntToStr(nCurRow+1),'B'+IntToStr(nCurRow+1)].RowHeight:=RowHgt2;
StatusBar.Panels[3].Text:=SrcSheet.Cells.Item[nIdx,1];
Self.Update;
Application.ProcessMessages;
TargetSheet.Range['K'+IntToStr(nCurRow+3),'K'+IntToStr(nCurRow+3)].Select;
SrcSheet.Range['B'+IntToStr(nIdx),'U'+IntToStr(nIdx)].Copy(TargetSheet.Range['B'+IntToStr(nCurRow+3),'B'+IntToStr(nCurRow+3)]);
//Temp:=StrToFloat(TargetSheet.Cells.Item[nCurRow+3,11]);
//TargetSheet.Cells.Item[nCurRow+3,11]:=IntToStr(Trunc(Temp*100))+'%';
TargetSheet.Cells.Item[nCurRow+3,11]:='10%';
TargetSheet.Range['A'+IntToStr(nCurRow+3),'U'+IntToStr(nCurRow+3)].Borders[3].Weight:=2;
TargetSheet.Range['A'+IntToStr(nCurRow+3),'U'+IntToStr(nCurRow+3)].Borders[4].Weight:=2;
TargetSheet.Cells.Item[nCurRow+3,22]:=SrcSheet.Cells.Item[I*33+2,2];
[red] TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormatLocal:='@';//设置单元格数字格式为百分比,可是并没有效果![/red]
TargetSheet.Cells.Item[nCurRow+3,1]:=' 2006年8月';
//TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormatLocal:='@';
//TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormat:='@';
TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].Borders[1].Weight:=2;
TargetSheet.Cells.Item[nCurRow+3,23]:=SrcSheet.Cells.Item[nIdx,1];
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].VerticalAlignment:=xlVAlignCenter;
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].HorizontalAlignment:=xlHAlignCenter;
for J:=1 to 4 do
begin
TargetSheet.Range['V'+IntToStr(nCurRow+3),'V'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
TargetSheet.Range['W'+IntToStr(nCurRow+3),'W'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
TargetSheet.Range['X'+IntToStr(nCurRow+3),'X'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
end;
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].NumberFormat:='';
with TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].Font do
begin
Color:=clBlack;
Size:=FontSize;
Bold:=False;
Italic:=False;
end;
TargetSheet.Range['A'+IntToStr(nCurRow+4),'A'+IntToStr(nCurRow+4)].RowHeight:=10;
Inc(nCurRow,5);
//TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+2)].Borders[3].Weight:=1;
end
else
begin
if Length(Trim(SrcSheet.Cells.Item[(I+1)*33+5,1]))<4 then bFlag:=False;
Break;
end;
end;
Inc(I);
end;
Break;
end;
SrcBook.Saved[0]:=True;
SrcBook.Close;
TargetBook.SaveCopyAs(edtTargetPath.Text);
TargetBook.Saved[0]:=True;
TargetBook.Close;
StatusBar.Panels[5].Text:='处理完成';
except
StatusBar.Panels[5].Text:='处理过程中发生错误,任务未完成';
end;
finally
SrcSheet.Disconnect;
TargetSheet.Disconnect;
SrcBook.Disconnect;
TargetBook.Disconnect;
ExcelApp.Quit;
ExcelApp.Disconnect;
ExcelApp.Free;
SrcBook.Free;
TargetBook.Free;
SrcSheet.Free;
TargetSheet.Free;
btnGo.Enabled:=True;
edtSrcpath.ReadOnly:=False;
edtTargetPath.ReadOnly:=False;
edtTemplateFile.ReadOnly:=False;
end;
if MessageBox(Handle,PAnsiChar('已保存至: '+edtTargetpath.Text+'。现在就查看吗?'),'保存成功',MB_YESNO+MB_ICONINFORMATION)=mrYes then
ShellExecute(0,'Open','C:/Program Files/Microsoft Office/Office/Excel.exe',PAnsiChar(edtTargetPath.Text),nil,SW_MAXIMIZE);
end;
procedure TFrmMain.edtTemplateFileDblClick(Sender: TObject);
var
dlgOpen:TOpenDialog;
begin
dlgOpen:=TOpenDialog.Create(Application);
with dlgOpen do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofPathMustExist in Options) then
Options:=Options+[ofPathMustExist];
if not (ofFileMustExist in Options) then
Options:=Options+[ofFileMustExist];
if Execute then
edtTemplateFile.Text:=FileName;
end;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
StatusBar.Panels[1].Text:='';
end;
procedure TFrmMain.edtSrcPathExit(Sender: TObject);
begin
if not btnGo.Enabled then Exit;
if FileExists(edtSrcPath.Text) and FileExists(edtTemplateFile.Text) and (Trim(edtTargetPath.Text)<>'') then
StatusBar.Panels[5].Text:='就绪,请点击GO按钮'
else
StatusBar.Panels[5].Text:='源文件或模板文件不存在';
end;
end.
unit SararyU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Excel2000,StdCtrls, ExtCtrls,ShellAPI, ComCtrls;
type
TFrmMain = class(TForm)
edtTargetPath: TLabeledEdit;
edtSrcPath: TLabeledEdit;
btnGO: TButton;
edtTemplateFile: TLabeledEdit;
StatusBar: TStatusBar;
procedure edtSrcPathDblClick(Sender: TObject);
procedure edtTargetPathDblClick(Sender: TObject);
procedure btnGOClick(Sender: TObject);
procedure edtTemplateFileDblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edtSrcPathExit(Sender: TObject);
//procedure WndProc(var Message:TMessage);override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.edtSrcPathDblClick(Sender: TObject);
var
dlgOpen:TOpenDialog;
begin
dlgOpen:=TOpenDialog.Create(Application);
try
with dlgOpen do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofPathMustExist in Options) then
Options:=Options+[ofPathMustExist];
if not (ofFileMustExist in Options) then
Options:=Options+[ofFileMustExist];
if Execute then
edtSrcPath.Text:=FileName;
end;
except
dlgOpen.Free;
end;
end;
procedure TFrmMain.edtTargetPathDblClick(Sender: TObject);
var
dlgSave:TSaveDialog;
begin
dlgSave:=TSaveDialog.Create(Application);
with dlgSave do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofCreatePrompt in Options) then
Options:=Options+[ofCreatePrompt];
if not (ofOverWritePrompt in Options) then
Options:=Options+[ofOverWritePrompt];
if Execute then
edtTargetPath.Text:=ChangeFileExt(FileName,'.xls');
if FileExists(FileName) then DeleteFile(FileName);
end;
end;
procedure TFrmMain.btnGOClick(Sender: TObject);
var
ExcelApp:TExcelApplication;
//ExcelApp:OleVariant;
SrcBook,TargetBook:TExcelWorkBook;
SrcSheet,TargetSheet:TExcelWorkSheet;
RowHgt:BYTE;
I,Idx,nIdx,nCurRow:Integer;
SheetCount:BYTE;
bFlag:Boolean;
J,FontSize:BYTE;
//Temp:Real;
begin
btnGo.Enabled:=False;
edtSrcpath.ReadOnly:=True;
edtTargetPath.ReadOnly:=True;
edtTemplateFile.ReadOnly:=True;
ExcelApp:=TExcelApplication.Create(nil);
SrcBook:=TExcelWorkBook.Create(nil);
TargetBook:=TExcelWorkBook.Create(nil);
SrcSheet:=TExcelWorkSheet.Create(nil);
TargetSheet:=TExcelWorkSheet.Create(nil);
try
try
ExcelApp.Connect;
ExcelApp.Caption:='工资条批量打印';
ExcelApp.Visible[0]:=True;
SrcBook.ConnectTo(ExcelApp.Workbooks.Add(edtSrcPath.Text,0));
Targetbook.ConnectTo(ExcelApp.Workbooks.Add(edtTemplateFile.Text,0));
TargetSheet.ConnectTo(TargetBook.Worksheets[1] as _WorkSheet);
//ShowMessage(TargetSheet.Range['K4','K4'].NumberFormat);
RowHgt:=TargetSheet.Range['B3','B3'].RowHeight;
FontSize:=TargetSheet.Range['B2','B2'].Font.Size;
//TargetBook.Activate;
SheetCount:=SrcBook.Worksheets.Count;
StatusBar.Panels[5].Text:='正在处理,请稍候';
for Idx:=1 to SheetCount do
begin
//if Idx<>3 then Continue;
SrcSheet.Disconnect;
TargetSheet.Disconnect;
SrcSheet.ConnectTo(SrcBook.Worksheets[Idx] as _WorkSheet);
TargetSheet.ConnectTo(TargetBook.Worksheets[Idx] as _Worksheet);
TargetSheet.Name:=SrcSheet.Name;
I:=0;
nCurRow:=1;
bFlag:=True;
while bFlag do
begin
StatusBar.Panels[1].Text:=SrcSheet.Cells.Item[I*33+2,2];
Self.Update;
Application.ProcessMessages;
for nIdx:=I*33+6 to I*33+30 do
begin
if Length(Trim(SrcSheet.Cells.Item[nIdx,1]))>=4 then
begin
if nCurRow>1 then
TargetSheet.Range['A1','X3'].Copy(TargetSheet.Range['A'+IntToStr(nCurRow),'A'+IntToStr(nCurRow)]);
TargetSheet.Range['B'+IntToStr(nCurRow+2),'B'+IntToStr(nCurRow+2)].RowHeight:=RowHgt;
//TargetSheet.Range['B'+IntToStr(nCurRow+1),'B'+IntToStr(nCurRow+1)].RowHeight:=RowHgt2;
StatusBar.Panels[3].Text:=SrcSheet.Cells.Item[nIdx,1];
Self.Update;
Application.ProcessMessages;
TargetSheet.Range['K'+IntToStr(nCurRow+3),'K'+IntToStr(nCurRow+3)].Select;
SrcSheet.Range['B'+IntToStr(nIdx),'U'+IntToStr(nIdx)].Copy(TargetSheet.Range['B'+IntToStr(nCurRow+3),'B'+IntToStr(nCurRow+3)]);
//Temp:=StrToFloat(TargetSheet.Cells.Item[nCurRow+3,11]);
//TargetSheet.Cells.Item[nCurRow+3,11]:=IntToStr(Trunc(Temp*100))+'%';
TargetSheet.Cells.Item[nCurRow+3,11]:='10%';
TargetSheet.Range['A'+IntToStr(nCurRow+3),'U'+IntToStr(nCurRow+3)].Borders[3].Weight:=2;
TargetSheet.Range['A'+IntToStr(nCurRow+3),'U'+IntToStr(nCurRow+3)].Borders[4].Weight:=2;
TargetSheet.Cells.Item[nCurRow+3,22]:=SrcSheet.Cells.Item[I*33+2,2];
[red] TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormatLocal:='@';//设置单元格数字格式为百分比,可是并没有效果![/red]
TargetSheet.Cells.Item[nCurRow+3,1]:=' 2006年8月';
//TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormatLocal:='@';
//TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].NumberFormat:='@';
TargetSheet.Range['A'+IntToStr(nCurRow+3),'A'+IntToStr(nCurRow+3)].Borders[1].Weight:=2;
TargetSheet.Cells.Item[nCurRow+3,23]:=SrcSheet.Cells.Item[nIdx,1];
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].VerticalAlignment:=xlVAlignCenter;
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].HorizontalAlignment:=xlHAlignCenter;
for J:=1 to 4 do
begin
TargetSheet.Range['V'+IntToStr(nCurRow+3),'V'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
TargetSheet.Range['W'+IntToStr(nCurRow+3),'W'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
TargetSheet.Range['X'+IntToStr(nCurRow+3),'X'+IntToStr(nCurRow+3)].Borders[J].Weight:=2;
end;
TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].NumberFormat:='';
with TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+3)].Font do
begin
Color:=clBlack;
Size:=FontSize;
Bold:=False;
Italic:=False;
end;
TargetSheet.Range['A'+IntToStr(nCurRow+4),'A'+IntToStr(nCurRow+4)].RowHeight:=10;
Inc(nCurRow,5);
//TargetSheet.Range['A'+IntToStr(nCurRow),'X'+IntToStr(nCurRow+2)].Borders[3].Weight:=1;
end
else
begin
if Length(Trim(SrcSheet.Cells.Item[(I+1)*33+5,1]))<4 then bFlag:=False;
Break;
end;
end;
Inc(I);
end;
Break;
end;
SrcBook.Saved[0]:=True;
SrcBook.Close;
TargetBook.SaveCopyAs(edtTargetPath.Text);
TargetBook.Saved[0]:=True;
TargetBook.Close;
StatusBar.Panels[5].Text:='处理完成';
except
StatusBar.Panels[5].Text:='处理过程中发生错误,任务未完成';
end;
finally
SrcSheet.Disconnect;
TargetSheet.Disconnect;
SrcBook.Disconnect;
TargetBook.Disconnect;
ExcelApp.Quit;
ExcelApp.Disconnect;
ExcelApp.Free;
SrcBook.Free;
TargetBook.Free;
SrcSheet.Free;
TargetSheet.Free;
btnGo.Enabled:=True;
edtSrcpath.ReadOnly:=False;
edtTargetPath.ReadOnly:=False;
edtTemplateFile.ReadOnly:=False;
end;
if MessageBox(Handle,PAnsiChar('已保存至: '+edtTargetpath.Text+'。现在就查看吗?'),'保存成功',MB_YESNO+MB_ICONINFORMATION)=mrYes then
ShellExecute(0,'Open','C:/Program Files/Microsoft Office/Office/Excel.exe',PAnsiChar(edtTargetPath.Text),nil,SW_MAXIMIZE);
end;
procedure TFrmMain.edtTemplateFileDblClick(Sender: TObject);
var
dlgOpen:TOpenDialog;
begin
dlgOpen:=TOpenDialog.Create(Application);
with dlgOpen do
begin
Filter:='Excel文档(*.xls)|*.xls';
InitialDir:=ExtractFilePath(Application.ExeName);
if not (ofPathMustExist in Options) then
Options:=Options+[ofPathMustExist];
if not (ofFileMustExist in Options) then
Options:=Options+[ofFileMustExist];
if Execute then
edtTemplateFile.Text:=FileName;
end;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
StatusBar.Panels[1].Text:='';
end;
procedure TFrmMain.edtSrcPathExit(Sender: TObject);
begin
if not btnGo.Enabled then Exit;
if FileExists(edtSrcPath.Text) and FileExists(edtTemplateFile.Text) and (Trim(edtTargetPath.Text)<>'') then
StatusBar.Panels[5].Text:='就绪,请点击GO按钮'
else
StatusBar.Panels[5].Text:='源文件或模板文件不存在';
end;
end.