15-04-2018, 07:47 PM
(آخر تعديل لهذه المشاركة: 15-04-2018, 07:51 PM بواسطة chardoneret.)
كود :
وجدت هذه الذالة و هي تعمل بشكل رائع و تفي بالغرضكود :
import an Excel Table to a TStringgrid?كود :
Autor: Thomas Stutzكود :
[ Print tip ]كود :
Tip Rating (196):كود :
usesكود :
ComObj;كود :
function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;كود :
constكود :
xlCellTypeLastCell = $0000000B;كود :
varكود :
XLApp, Sheet: OLEVariant;كود :
RangeMatrix: Variant;كود :
x, y, k, r: Integer;كود :
beginكود :
Result := False;كود :
// Create Excel-OLE Objectكود :
XLApp := CreateOleObject('Excel.Application');كود :
tryكود :
// Hide Excelكود :
XLApp.Visible := False;كود :
// Open the Workbookكود :
XLApp.Workbooks.Open(AXLSFile);كود :
// Sheet := XLApp.Workbooks[1].WorkSheets[1];كود :
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];كود :
// In order to know the dimension of the WorkSheet, i.e the number of rowsكود :
// and the number of columns, we activate the last non-empty cell of itكود :
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;كود :
// Get the value of the last rowكود :
x := XLApp.ActiveCell.Row;كود :
// Get the value of the last columnكود :
y := XLApp.ActiveCell.Column;كود :
// Set Stringgrid's row &col dimensions.كود :
AGrid.RowCount := x;كود :
AGrid.ColCount := y;كود :
// Assign the Variant associated with the WorkSheet to the Delphi Variantكود :
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;كود :
// Define the loop for filling in the TStringGridكود :
k := 1;كود :
repeatكود :
for r := 1 to y doكود :
AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];كود :
Inc(k, 1);كود :
AGrid.RowCount := k + 1;كود :
until k > x;كود :
// Unassign the Delphi Variant Matrixكود :
RangeMatrix := Unassigned;كود :
finallyكود :
// Quit Excelكود :
if not VarIsEmpty(XLApp) thenكود :
beginكود :
// XLApp.DisplayAlerts := False;كود :
XLApp.Quit;كود :
XLAPP := Unassigned;كود :
Sheet := Unassigned;كود :
Result := True;كود :
end;كود :
end;كود :
end;كود :
procedure TForm1.Button1Click(Sender: TObject);كود :
beginكود :
if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') thenكود :
ShowMessage('Table has been exported!');كود :
end;وجدت هذه الذالة و هي تعمل بشكل رائع و تفي بالغرض
import an Excel Table to a TStringgrid?
Autor: Thomas Stutz
[ Print tip ]
Tip Rating (196):
uses
ComObj;
function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
// Create Excel-OLE Object
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Open the Workbook
XLApp.Workbooks.Open(AXLSFile);
// Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
// In order to know the dimension of the WorkSheet, i.e the number of rows
// and the number of columns, we activate the last non-empty cell of it
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
// Get the value of the last row
x := XLApp.ActiveCell.Row;
// Get the value of the last column
y := XLApp.ActiveCell.Column;
// Set Stringgrid's row &col dimensions.
AGrid.RowCount := x;
AGrid.ColCount := y;
// Assign the Variant associated with the WorkSheet to the Delphi Variant
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
// Define the loop for filling in the TStringGrid
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
// Unassign the Delphi Variant Matrix
RangeMatrix := Unassigned;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
// XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') then
ShowMessage('Table has been exported!');
end;