Soyez le premier à donner votre avis sur cette source.
Vue 29 746 fois - Téléchargée 2 944 fois
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtnrs, ExtCtrls; type TForm1 = class(TForm) OleContainer1: TOleContainer; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Déclarations privées } public { Déclarations publiques } end; var Form1: TForm1; Options : array[3..5] of Shortint; oExcel,oCommandBars:OleVariant; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var oActiveWindow, oActiveWorkBook, oSelection, oActiveSheet, oCells, oColumns :OleVariant; i,j :Cardinal; const //Alignement xlCenter=-4108; //Bordures //xlEdgeLeft=7; //xlEdgeTop=8; //xlEdgeBottom=9; //xlEdgeRight=10; //xlInsideVertical=11; //xlInsideHorizontal=12; //Largeur de ligne xlContinuous=1; //xlThin=2; //xlMedium=-4138; //Couleur xlAutomatic=-4105; begin with OleContainer1 do begin Align:=alClient; CreateObject('Excel.Sheet', False); Doverb(ovPrimary); end; //Variables objets oExcel:=OleContainer1.OleObject.Application; oCommandBars:=OleContainer1.oleobject.CommandBars; oActiveWindow:=oExcel.ActiveWindow; oActiveWorkBook:=oExcel.ActiveWorkBook; oActiveSheet:=oExcel.ActiveSheet; oColumns:=oExcel.Columns; oCells:=oActiveSheet.Cells; oSelection:=oExcel.Selection; //Titre Form1.Caption:=oActiveWorkBook.Name; (* A. Options d'affichage *) //Affiche au moins les barres d'outils " Standard " et " Mise en forme " for i:=3 to 4 do begin Options[i]:=oCommandBars.Item[i].Visible; if Options[i]=0 then oCommandBars.Item[i].Visible:=-1; end; //Coche si nécessaire l'option d'affichage de la barre de formule Options[5]:=oExcel.DisplayFormulaBar; if (Options[5]=0) then oExcel.DisplayFormulaBar:=-1; (* B. Tableau de données *) //En-têtes de colonnes for i:=2 to 8 do oCells.Item[2,i].Value:= 'En-tête col. ' + IntToStr(i); //Données for i:=3 to 8 do for j:=2 to 8 do oCells.Item[i,j].Value:=' Cells(' + IntToStr(i) + ', ' + IntToStr(j) + ') '; (* C. Mise en forme *) //Sélection des en-têtes oSelection:=oActiveSheet.Range[oCells.Item[2,2], oCells.Item[2,8]]; //Propriétés de la police des en-têtes oSelection.Font.Bold:=1; oSelection.Font.ColorIndex := 9; //Couleur de fond de la sélection oSelection.Interior.ColorIndex := 15; //Centrer les en-têtes oSelection.HorizontalAlignment:= xlCenter; //Bordures for i:=7 to 11 do oSelection.Borders[i].LineStyle:=xlContinuous; //Sélection oActiveSheet.Rows[3].Select; //Figer les volets oActiveWindow.FreezePanes:=1; //Ajustement automatique des colonnes for i:=2 to 8 do oColumns.Item[i].AutoFit; //Largeur de la colonne 1 oColumns.Item[1].ColumnWidth:=1.71; //Sélection finale oCells.Item[3, 2].Select; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin if (OleContainer1.State=osUIActive) then begin //Rétablie les options initiales d'affichage oCommandBars.Item[3].Visible:=Options[3]; oCommandBars.Item[4].Visible:=Options[4]; oExcel.DisplayFormulaBar:=Options[5]; //Ferme l'instance oExcel.Quit; end; //Ferme la fiche Action:=caFree; end; end.
Commentaires
OleContainer1.SaveAsDocument('C:\MonFichier.xls');
MERCI DE VOTRE AIDE
{**************************************************************}
uses
ComObj;
function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{2. Without OLE }
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;
// Example:
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveAsExcelFile(StringGrid1, 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{3. Code by Reinhard Schatzl }
uses
ComObj;
// Hilfsfunktion für StringGridToExcelSheet
// Helper function for StringGridToExcelSheet
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
// StringGrid Inhalt in Excel exportieren
// Export StringGrid contents to Excel
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName: string;
begin
//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then
BookCount := BookCount - 1;
//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = False then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufügen
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256 then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536 then
SheetRowCount := Grid.RowCount
else
SheetRowCount := 65536;
//Sheets befüllen
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I + 256 * (N - 1)) <= Grid.ColCount) and
((J + 65536 * (M - 1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
//-------------------------
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),
RefToCell(SheetRowCount, SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value :=
Data;
end;
end;
//Save Excel Worksheet
try
for M := 1 to BookCount do
begin
SaveFileName := Copy(FileName, 1,Pos('.', FileName) - 1) + IntToStr(M) +
Copy(FileName, Pos('.', FileName),
Length(FileName) - Pos('.', FileName) + 1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error ?
end;
finally
//Excel Beenden
if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
//StringGrid inhalt in Excel exportieren
//Grid : stringGrid, SheetName : stringgrid Print, Pfad : c:\Test\ExcelFile.xls, Excelsheet anzeigen
StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:\Test\ExcelFile.xls', True);
end;
{**************************************************************}
Bon courage
est ce ke vous pouvez m'aider un peu plus ou je peux trouvez les exemples.
merci
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.