1. 程式人生 > >Delphi 轉EXCEL 合併單元格解決方案

Delphi 轉EXCEL 合併單元格解決方案

廢話少說先上傳程式碼,自己看吧!

procedure TForm1.Button10Click(Sender: TObject);
var
  FExcel:Variant;
  FWorkbook:Variant;
  FWorkSheet:Variant;
  XlsFileName:String;
  i,j:Integer;
  Field1,field2,Field3,Field4:string;
  LastField1,LastField2,Lastfield3,LastField4:string;
   savedailog:TSaveDialog;
begin
   savedailog:=TSaveDialog.Create(Self);
   savedailog.Filter:='Excel files (*.xls)|*.XlS';
   if savedailog.Execute then begin
        xlsfilename:=savedailog.FileName;
        savedailog.Free;
     end
   else begin
      savedailog.Free;
      exit;
   end;
  screen.Cursor := crHourGlass;
  Try
     FExcel := CreateOleObject('Excel.application');
  except
     screen.Cursor:=crDefault;
     ShowMessage('出錯!沒有安裝Excel軟體!');
     exit;
  end;
  FExcel.DisplayAlerts :=false ; //不提示彈出對話方塊
  try
     FWorkbook :=FExcel.WorkBooks.Add;
     DM.Q_FindProcess.First;
     LastField1:='';
     LastField2:='';
     Lastfield3:='';
     Lastfield4:='';
     if DM.Q_FindProcess.RecordCount >0 then begin
        //新增表頭
        j:=1;
              FExcel.cells[j,1]:='專案名稱';
              FExcel.cells[j,2]:='產品名稱';
              FExcel.cells[j,3]:='模具';
              FExcel.cells[j,4]:='節點';
              FExcel.cells[j,5]:='序號';
              FExcel.cells[j,6]:='事項內容';
              FExcel.cells[j,7]:='計劃日期';
              FExcel.cells[j,8]:='實際日期';
              FExcel.cells[j,9]:='狀態';
              FExcel.cells[j,10]:='備註';
              FExcel.cells[j,11]:='型別';
        //新增表身
        for i:=1 to DM.Q_FindProcess.RecordCount do begin
            j:=i+1;
            Field1:=DM.Q_FindProcessMainProjectName.AsString;
            field2:=DM.Q_FindProcessSubProjectName.AsString;
            field3:=DM.Q_FindProcessMouldName.AsString;
            field4:=DM.Q_FindProcessProjectStatusName.AsString;
            try
              FExcel.cells[j,1]:=DM.Q_FindProcessMainProjectName.AsString;
              FExcel.cells[j,2]:=DM.Q_FindProcessSubProjectName.AsString;
              FExcel.cells[j,3]:=DM.Q_FindProcessMouldName.AsString;
              FExcel.cells[j,4]:=DM.Q_FindProcessProjectStatusName.AsString;
              FExcel.cells[j,5]:=DM.Q_FindProcessSeq.AsString;
              FExcel.cells[j,6]:=DM.Q_FindProcessWorkContent.AsString;
              FExcel.cells[j,7]:=DM.Q_FindProcessPlanDatePoint.AsString;
              FExcel.cells[j,8]:=DM.Q_FindProcessActDatePoint.AsString;
              FExcel.cells[j,9]:=DM.Q_FindProcessSubStatus.AsString;
              FExcel.cells[j,10]:=DM.Q_FindProcessRemark.AsString;
              FExcel.cells[j,11]:=DM.Q_FindProcessSubProjectType.AsString;
              if Field1 = LastField1 then
                 FExcel.Range[FExcel.Cells[j-1,1],FExcel.Cells[j,1]].MergeCells:=True;
              if Field2 = LastField2 then
                 FExcel.Range[FExcel.Cells[j-1,2],FExcel.Cells[j,2]].MergeCells:=True;
              if Field3 = LastField3 then
                 FExcel.Range[FExcel.Cells[j-1,3],FExcel.Cells[j,3]].MergeCells:=True;
              if Field4 = LastField4 then
                 FExcel.Range[FExcel.Cells[j-1,4],FExcel.Cells[j,4]].MergeCells:=True;
              LastField1 := Field1;
              LastField2 := Field2;
              LastField3 := Field3;
              LastField4 := Field4;
            finally
              FExcel.Visible := true;
              Screen.Cursor := crDefault;
            end;
            DM.Q_FindProcess.Next;
        end;
     end;
     FWorkSheet.saveas(xlsfilename);
     FExcel.quit;
     ShowMessage('輸出 Excel 檔案已完成。。。');
  Except
     ShowMessage('出錯!輸出檔案錯誤!');
     FWorkBook.Close;
     FExcel.Quit;
     Exit;
  end;
end;