有一個原始表格sheet1,抽取里面的部分資料生成sheet2,打算把sheet2另存為一個新的xlsx檔案,試過各種方法搜索過N多復制來的帖子,結果都是新表格里面有兩個sheet,求大神指點!
procedure TForm1.Button1Click(Sender: TObject);
var
bt: String;
ExcelApp: Variant;
EB1: Variant;
i, j, l, m, MaxRow: Integer;
begin
bt := ComboBox1.Text;
l := ComboBox1.ItemIndex;
if messagebox(handle, Pchar('確認共有 ' + IntToStr(ComboBox2.Items.Count) + ' 個【'
+ bt + '】進行拆分?'), '提示', MB_YESNO) = IDYES then
begin
ExcelApp := CreateOleObject('Excel.Application');
EB1 := ExcelApp.WorkBooks.Open(Edit1.Text);
ExcelApp.ActiveWorkBook.Sheets.Add
(After := ExcelApp.ActiveWorkBook.Sheets[1]);
MaxRow := EB1.Sheets[1].UsedRange.Rows.Count;
for m := 0 to ComboBox2.Items.Count - 1 do
begin
EB1.Sheets[2].Delete;
ExcelApp.ActiveWorkBook.Sheets.Add
(After := ExcelApp.ActiveWorkBook.Sheets[1]);
ComboBox2.ItemIndex := m;
EB1.Sheets[1].Rows[1].Copy;
EB1.Sheets[2].Rows[1].PasteSpecial;
j := 2;
for i := 1 to MaxRow do
begin
if EB1.Sheets[1].Cells[i, l + 1].Text = ComboBox2.Text then
begin
EB1.Sheets[1].Rows[i].Copy;
EB1.Sheets[2].Rows[j].PasteSpecial;
j := j + 1;
end;
end;
EB1.Sheets[2].name := ComboBox2.Text;
EB1.Sheets[2].Cells[1, 1].Select;
EB1.Sheets[2].Columns.EntireColumn.AutoFit;
ExcelApp.ActiveWorkBook.Sheets[2].UsedRange.SaveAs
(ExtractFilePath(OpenDialog1.FileName) + ComboBox2.Text);
end;
messagebox(handle, '檔案拆分完成!', '提示', 0 + 64);
Edit1.Clear;
OpenDialog1.FileName := '';
ComboBox1.Items.Clear;
ComboBox2.Items.Clear;
ExcelApp.ActiveWorkBook.Save;
ExcelApp.DisplayAlerts := False;
ExcelApp.Quit;
end;
end;
轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/71394.html
標籤:語言基礎/算法/系統設計
上一篇:關于IDispatch
