V
vazumi
Unregistered / Unconfirmed
GUEST, unregistred user!
俺的想法是把眾多的Excel模板放在一個xls文件裡面,多幾個sheet而已嘛
調用的時候copy一個sheet就可以往裡面填充數據了,問題來了
在同一個xls文件裡copy一個sheet我會,可是需要在一個新xls裡copy一個sheet
寫不出來了,下面是一段還未完善的代碼
還有那個殺死EXCEL進程的方法感覺也不是很妥當,這樣會關掉所有的EXCEL進程,且不提示保存!!
procedure Tfrmrpt.GetXls(q: TADOQuery);
var
ModuleName: string;
FileName: string;
Col, Row: Integer;
ExlApp: Variant;
i, j: Integer;
myxls: Variant;
begin
if not q.Active then
exit;
if q.RecordCount = 0 then
begin
MessageBox(Handle, '沒有數據可供導出!', '確認', MB_ok + MB_ICONWARNING);
exit;
end;
if not SaveDialog1.Execute then
exit;
if SaveDialog1.FileName = '' then
exit;
FileName := SaveDialog1.FileName;
ModuleName := extractfilepath(paramstr(0)) + 'RPT/Module.xls';
if FileExists(ModuleName) = False then
begin
ShowMessage('報表模板文件:' + ModuleName + '不存在!請聯系開發者!');
exit;
end;
//-------------------------------------------------------------------------
try
ExlApp := CreateOleObject('Excel.application');
ExlApp.WorkBooks.Open(ModuleName);
ExlApp.WorkSheets[1].Activate;
q.First;
i := 1;
while not (q.Eof)do
begin
for j := 1 to q.FieldCount + 1 - 1do
ExlApp.Cells.Item[i + 3, j] := q.Fields[j - 1].AsString;
q.Next;
i := i + 1;
end;
FileName := Trim(FileName);
if FileExists(FileName) then
DeleteFile(FileName);
ExlApp.ActiveWorkBook.SaveAs(FileName);
ExlApp.WorkBooks.Close;
ExlApp.Quit;
ExlApp := Unassigned;
TerminateOLE;
shellexecute(Handle, 'open', pchar(FileName), nil, nil, sw_shownormal);
except
on exceptiondo
raise exception.Create('請確認您的機器上是否已安裝Excel!');
end;
end;
procedure Tfrmrpt.TerminateOLE;
var
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
Ret: BOOL;
ProcessID: Integer;
s: string;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
Ret := Process32First(FSnapshotHandle, FProcessEntry32);
while Retdo
begin
s := ExtractFileName(FProcessEntry32.szExeFile);
if s = 'EXCEL.EXE' then
begin
ProcessID := FProcessEntry32.th32ProcessID;
TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, ProcessID), 1);
s := '';
end;
Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;
調用的時候copy一個sheet就可以往裡面填充數據了,問題來了
在同一個xls文件裡copy一個sheet我會,可是需要在一個新xls裡copy一個sheet
寫不出來了,下面是一段還未完善的代碼
還有那個殺死EXCEL進程的方法感覺也不是很妥當,這樣會關掉所有的EXCEL進程,且不提示保存!!
procedure Tfrmrpt.GetXls(q: TADOQuery);
var
ModuleName: string;
FileName: string;
Col, Row: Integer;
ExlApp: Variant;
i, j: Integer;
myxls: Variant;
begin
if not q.Active then
exit;
if q.RecordCount = 0 then
begin
MessageBox(Handle, '沒有數據可供導出!', '確認', MB_ok + MB_ICONWARNING);
exit;
end;
if not SaveDialog1.Execute then
exit;
if SaveDialog1.FileName = '' then
exit;
FileName := SaveDialog1.FileName;
ModuleName := extractfilepath(paramstr(0)) + 'RPT/Module.xls';
if FileExists(ModuleName) = False then
begin
ShowMessage('報表模板文件:' + ModuleName + '不存在!請聯系開發者!');
exit;
end;
//-------------------------------------------------------------------------
try
ExlApp := CreateOleObject('Excel.application');
ExlApp.WorkBooks.Open(ModuleName);
ExlApp.WorkSheets[1].Activate;
q.First;
i := 1;
while not (q.Eof)do
begin
for j := 1 to q.FieldCount + 1 - 1do
ExlApp.Cells.Item[i + 3, j] := q.Fields[j - 1].AsString;
q.Next;
i := i + 1;
end;
FileName := Trim(FileName);
if FileExists(FileName) then
DeleteFile(FileName);
ExlApp.ActiveWorkBook.SaveAs(FileName);
ExlApp.WorkBooks.Close;
ExlApp.Quit;
ExlApp := Unassigned;
TerminateOLE;
shellexecute(Handle, 'open', pchar(FileName), nil, nil, sw_shownormal);
except
on exceptiondo
raise exception.Create('請確認您的機器上是否已安裝Excel!');
end;
end;
procedure Tfrmrpt.TerminateOLE;
var
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
Ret: BOOL;
ProcessID: Integer;
s: string;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
Ret := Process32First(FSnapshotHandle, FProcessEntry32);
while Retdo
begin
s := ExtractFileName(FProcessEntry32.szExeFile);
if s = 'EXCEL.EXE' then
begin
ProcessID := FProcessEntry32.th32ProcessID;
TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, ProcessID), 1);
s := '';
end;
Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;