有没有例子呀??? 我作是作出来了 可速度太慢了 怎么回事呀 大侠帮忙看看 是用这语句吗?? for i:=0 to ZZZ do for j := 0 to XXX do ExcelWorksheet.Cells.Item[i, j] := DBGrid_List.Fields[j].AsString;
----------------------------------------------
我我,我是一只菜鸟,菜菜菜菜菜菜,菜菜菜菜菜菜菜菜菜菜菜菜~~~~~~~~~
procedure CopyDbDataToExcel(Target: TDbgrid); var iCount, jCount: Integer; XLApp: Variant; Sheet: Variant; begin Screen.Cursor := crHourGlass; if not VarIsEmpty(XLApp) then begin XLApp.DisplayAlerts := False; XLApp.Quit; VarClear(XLApp); end; //通过ole创建Excel对象 try XLApp := CreateOleObject('Excel.Application'); except Screen.Cursor := crDefault; Exit; end; XLApp.WorkBooks.Add[XLWBatWorksheet]; XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄'; Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄']; if not Target.DataSource.DataSet.Active then begin Screen.Cursor := crDefault; Exit; end; Target.DataSource.DataSet.first;
for iCount := 0 to Target.Columns.Count - 1 do begin Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption; end; jCount := 1; while not Target.DataSource.DataSet.Eof do begin for iCount := 0 to Target.Columns.Count - 1 do begin Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString; end; Inc(jCount); Target.DataSource.DataSet.Next; end; XlApp.Visible := True; Screen.Cursor := crDefault; end;
----------------------------------------------
我爱DELPHI
看看我的函数 function ExportToExcel(Header: String; vDataSet: TDataSet): Boolean; var I,VL_I,j: integer; S,SysPath: string; MsExcel:Variant; begin Result:=true; if Application.MessageBox('您确信将数据导入到Excel吗?','提示!',MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then begin SysPath:=ExtractFilePath(application.exename); with TStringList.Create do try vDataSet.First ; S:=S+Header; // system.Delete(s,1,1); add(s); s:='; For I:=0 to vDataSet.fieldcount-1 do begin If vDataSet.fields[I].visible=true then S:=S+#9+vDataSet.fields[I].displaylabel; end; system.Delete(s,1,1); add(s); while not vDataSet.Eof do begin S := '; for I := 0 to vDataSet.FieldCount -1 do begin If vDataSet.fields[I].visible=true then S := S + #9 + vDataSet.Fields[I].AsString; end; System.Delete(S, 1, 1); Add(S); vDataSet.Next; end; Try SaveToFile(SysPath+'\Tem.xls'); Except ShowMessage('写文件时发生保护性错误,Excel 如在运行,请先关闭!'); Result:=false; exit; end; finally Free; end; Try MSExcel:=CreateOleObject('Excel.Application'); Except ShowMessage('Excel 没有安装,请先安装!'); Result:=false; exit; end; Try MSExcel.workbooks.open(SysPath+'\Tem.xls'); Except ShowMessage('打开临时文件时出错,请检查'+SysPath+'\Tem.xls'); Result:=false; exit; end; MSExcel.visible:=True; for VL_I :=1 to 4 do MSExcel.Selection.Borders[VL_I].LineStyle := 0; MSExcel.cells.select; MSExcel.Selection.HorizontalAlignment :=3; MSExcel.Selection.Borders[1].LineStyle := 0;
destructor TOLEExcel.Destroy; begin FCellFont.Free; FTitleFont.Free; inherited Destroy; end;
procedure TOLEExcel.SetExcelCellFont(var Cell: Variant); begin if FIgnoreFont then exit; with FCellFont do begin Cell.Font.Name := Name; Cell.Font.Size := Size; Cell.Font.Color := Color; Cell.Font.Bold := fsBold in Style; Cell.Font.Italic := fsItalic in Style; Cell.Font.UnderLine := fsUnderline in Style; Cell.Font.Strikethrough := fsStrikeout in Style; end; end;
procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant); begin if FIgnoreFont then exit; with FTitleFont do begin Cell.Font.Name := Name; Cell.Font.Size := Size; Cell.Font.Color := Color; Cell.Font.Bold := fsBold in Style; Cell.Font.Italic := fsItalic in Style; Cell.Font.UnderLine := fsUnderline in Style; Cell.Font.Strikethrough := fsStrikeout in Style; end; end;
procedure TOLEExcel.SetVisible(DoShow: Boolean); begin if not FExcelCreated then exit; if DoShow then FExcel.Visible := True else FExcel.Visible := False; end;
function TOLEExcel.GetCell(ACol, ARow: Integer): string; begin if not FExcelCreated then exit; result := FWorkSheet.Cells[ARow, ACol]; end;
procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string); var Cell: Variant; begin if not FExcelCreated then exit; Cell := FWorkSheet.Cells[ARow, ACol]; SetExcelCellFont(Cell); Cell.Value := Value; end;
function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime; begin if not FExcelCreated then begin result := 0; exit; end; result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]); end;
procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime); var Cell: Variant; begin if not FExcelCreated then exit; Cell := FWorkSheet.Cells[ARow, ACol]; SetExcelCellFont(Cell); Cell.Value := '' + DateTimeToStr(Value); end;
function TOLEExcel.IsCreated: Boolean; begin result := FExcelCreated; end;
procedure TOLEExcel.SetTitleFont(NewFont: TFont); begin if NewFont <> FTitleFont then FTitleFont.Assign(NewFont); end;
procedure TOLEExcel.SetCellFont(NewFont: TFont); begin if NewFont <> FCellFont then FCellFont.Assign(NewFont); end;
procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant); var Col: integer; begin for Col := 0 to Table.FieldCount - 1 do begin Cell := FWorkSheet.Cells[1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := Table.Fields[Col].FieldName; end; end;
procedure TOLEExcel.TableToExcel(const Table: TTable); var Col, Row: LongInt; Cell: Variant; begin if not FExcelCreated then exit; if Table.Active = False then exit;
GetTableColumnName(Table, Cell); Row := 2; with Table do begin first; while not EOF do begin for Col := 0 to FieldCount - 1 do begin Cell := FWorkSheet.Cells[Row, Col + 1]; SetExcelCellFont(Cell); Cell.Value := Fields[Col].AsString; end; next; Inc(Row); end; end; end;
procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant); var Col: integer; begin for Col := 0 to Query.FieldCount - 1 do begin Cell := FWorkSheet.Cells[1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := Query.Fields[Col].FieldName; end; end;
procedure TOLEExcel.QueryToExcel(const Query: TQuery); var Col, Row: LongInt; Cell: Variant; begin if not FExcelCreated then exit; if Query.Active = False then exit;
GetQueryColumnName(Query, Cell); Row := 2; with Query do begin first; while not EOF do begin for Col := 0 to FieldCount - 1 do begin Cell := FWorkSheet.Cells[Row, Col + 1]; SetExcelCellFont(Cell); Cell.Value := Fields[Col].AsString; end; next; Inc(Row); end; end; end;
procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row: LongInt; begin for Col := 0 to StringGrid.FixedCols - 1 do for Row := 0 to StringGrid.RowCount - 1 do begin Cell := FWorkSheet.Cells[Row + 1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := StringGrid.Cells[Col, Row]; end; end;
procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row: LongInt; begin for Row := 0 to StringGrid.FixedRows - 1 do for Col := 0 to StringGrid.ColCount - 1 do begin Cell := FWorkSheet.Cells[Row + 1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := StringGrid.Cells[Col, Row]; end; end;
procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row, x, y: LongInt; begin Col := StringGrid.FixedCols; Row := StringGrid.FixedRows; for x := Row to StringGrid.RowCount - 1 do for y := Col to StringGrid.ColCount - 1 do begin Cell := FWorkSheet.Cells[x + 1, y + 1]; SetExcelCellFont(Cell); Cell.Value := StringGrid.Cells[y, x]; end; end;
procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid); var Cell: Variant; begin if not FExcelCreated then exit; GetFixedCols(StringGrid, Cell); GetFixedRows(StringGrid, Cell); GetStringGridBody(StringGrid, Cell); end;
procedure TOLEExcel.SaveToExcel(const FileName: string); begin if not FExcelCreated then exit; FWorkSheet.SaveAs(FileName); end;
procedure Register; begin RegisterComponents('Tanglu', [TOLEExcel]); end;
destructor TAdoToOleExcel.Destroy; begin FCellFont.Free; FTitleFont.Free; inherited Destroy; end;
procedure TAdoToOleExcel.SetExcelCellFont(var Cell: Variant); begin if FIgnoreFont then exit; with FCellFont do begin Cell.Font.Name := Name; Cell.Font.Size := Size; Cell.Font.Color := Color; Cell.Font.Bold := fsBold in Style; Cell.Font.Italic := fsItalic in Style; Cell.Font.UnderLine := fsUnderline in Style; Cell.Font.Strikethrough := fsStrikeout in Style; end; end;
procedure TAdoToOleExcel.SetExcelTitleFont(var Cell: Variant); begin if FIgnoreFont then exit; with FTitleFont do begin Cell.Font.Name := Name; Cell.Font.Size := Size; Cell.Font.Color := Color; Cell.Font.Bold := fsBold in Style; Cell.Font.Italic := fsItalic in Style; Cell.Font.UnderLine := fsUnderline in Style; Cell.Font.Strikethrough := fsStrikeout in Style; end; end;
procedure TAdoToOleExcel.SetVisible(DoShow: Boolean); begin if not FExcelCreated then exit; if DoShow then FExcel.Visible := True else FExcel.Visible := False; end;
function TAdoToOleExcel.GetCell(ACol, ARow: Integer): string; begin if not FExcelCreated then exit; result := FWorkSheet.Cells[ARow, ACol]; end;
procedure TAdoToOleExcel.SetCell(ACol, ARow: Integer; const Value: string); var Cell: Variant; begin if not FExcelCreated then exit; Cell := FWorkSheet.Cells[ARow, ACol]; SetExcelCellFont(Cell); Cell.Value := Value; end;
function TAdoToOleExcel.GetDateCell(ACol, ARow: Integer): TDateTime; begin if not FExcelCreated then begin result := 0; exit; end; result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]); end;
procedure TAdoToOleExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime); var Cell: Variant; begin if not FExcelCreated then exit; Cell := FWorkSheet.Cells[ARow, ACol]; SetExcelCellFont(Cell); Cell.Value := '' + DateTimeToStr(Value); end;
function TAdoToOleExcel.IsCreated: Boolean; begin result := FExcelCreated; end;
procedure TAdoToOleExcel.SetTitleFont(NewFont: TFont); begin if NewFont <> FTitleFont then FTitleFont.Assign(NewFont); end;
procedure TAdoToOleExcel.SetCellFont(NewFont: TFont); begin if NewFont <> FCellFont then FCellFont.Assign(NewFont); end;
procedure TAdoToOleExcel.GetTableColumnName(const ADOTable: TADOTable; var Cell: Variant); var Col: integer; begin for Col := 0 to ADOTable.FieldCount - 1 do begin Cell := FWorkSheet.Cells[1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := ADOTable.Fields[Col].FieldName; end; end;
procedure TAdoToOleExcel.ADOTableToExcel(const ADOTable: TADOTable); var Col, Row: LongInt; Cell: Variant; begin if not FExcelCreated then exit; if ADOTable.Active = False then exit;
GetTableColumnName(ADOTable, Cell); Row := 2; with ADOTable do begin first; while not EOF do begin for Col := 0 to FieldCount - 1 do begin Cell := FWorkSheet.Cells[Row, Col + 1]; SetExcelCellFont(Cell); Cell.Value := Fields[Col].AsString; end; next; Inc(Row); end; end; end;
procedure TAdoToOleExcel.GetQueryColumnName(const ADOQuery: TADOQuery; var Cell: Variant); var Col: integer; begin for Col := 0 to ADOQuery.FieldCount - 1 do begin Cell := FWorkSheet.Cells[1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := ADOQuery.Fields[Col].FieldName; end; end;
procedure TAdoToOleExcel.ADOQueryToExcel(const ADOQuery: TADOQuery); var Col, Row: LongInt; Cell: Variant; begin if not FExcelCreated then exit; if ADOQuery.Active = False then exit;
GetQueryColumnName(ADOQuery, Cell); Row := 2; with ADOQuery do begin first; while not EOF do begin for Col := 0 to FieldCount - 1 do begin Cell := FWorkSheet.Cells[Row, Col + 1]; SetExcelCellFont(Cell); Cell.Value := Fields[Col].AsString; end; next; Inc(Row); end; end; end;
procedure TAdoToOleExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row: LongInt; begin for Col := 0 to StringGrid.FixedCols - 1 do for Row := 0 to StringGrid.RowCount - 1 do begin Cell := FWorkSheet.Cells[Row + 1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := StringGrid.Cells[Col, Row]; end; end;
procedure TAdoToOleExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row: LongInt; begin for Row := 0 to StringGrid.FixedRows - 1 do for Col := 0 to StringGrid.ColCount - 1 do begin Cell := FWorkSheet.Cells[Row + 1, Col + 1]; SetExcelTitleFont(Cell); Cell.Value := StringGrid.Cells[Col, Row]; end; end;
procedure TAdoToOleExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant); var Col, Row, x, y: LongInt; begin Col := StringGrid.FixedCols; Row := StringGrid.FixedRows; for x := Row to StringGrid.RowCount - 1 do for y := Col to StringGrid.ColCount - 1 do begin Cell := FWorkSheet.Cells[x + 1, y + 1]; SetExcelCellFont(Cell); Cell.Value := StringGrid.Cells[y, x]; end; end;
procedure TAdoToOleExcel.StringGridToExcel(const StringGrid: TStringGrid); var Cell: Variant; begin if not FExcelCreated then exit; GetFixedCols(StringGrid, Cell); GetFixedRows(StringGrid, Cell); GetStringGridBody(StringGrid, Cell); end;
procedure TAdoToOleExcel.SaveToExcel(const FileName: string); begin if not FExcelCreated then exit; FWorkSheet.SaveAs(FileName); end;
procedure Register; begin RegisterComponents('Freeman', [TAdoToOleExcel]); end;