ذخیره اکسل در StringGrid دلفی

ذخیره فایل  اکسل در StringGrid دلفی ,  سپس ذخیره محتویات  StringGrid  در جدول دلفی .

با این کد شما می توانید هر فایل اکسل را در دلفی قرار دهید. دقت کنید حتما یونیت System.Win.ComObj را به قسمت یونیت های مورد استفاده قرار دهید .

 

///  Import Excel In To StringGrid In Delphi

/// Save StringGrid To Table In Delphi

-----------------------------------------------------------------------------------------------------------------------------------

 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    Button2: TButton;
    FileOpenDialog1: TFileOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   function Xls_To_StringGrid(AGrid: TStringGrid;  AXLSFile: string): Boolean;

    { Private declarations }
  public


  { Public declarations }

  end;

var
  Form1: TForm1;

implementation
 uses  System.Win.ComObj, Unit4;
{$R *.dfm}
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
  f:    TextFile;
  i, k: Integer;
begin
  AssignFile(f, FileName);
  Rewrite(f);
  with StringGrid do
  begin
    // Write number of Columns/Rows
    Writeln(f, ColCount);
    Writeln(f, RowCount);
    // loop through cells
    for i := 0 to ColCount - 1 do
      for k := 0 to RowCount - 1 do
        Writeln(F, Cells[i, k]);
  end;
  CloseFile(F);
end;

// Load a TStringGrid from a file

procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
  f:          TextFile;
  iTmp, i, k: Integer;
  strTemp:    String;
begin
  AssignFile(f, FileName);
  Reset(f);
  with StringGrid do
  begin
    // Get number of columns
    Readln(f, iTmp);
    ColCount := iTmp;
    // Get number of rows
    Readln(f, iTmp);
    RowCount := iTmp;
    // loop through cells & fill in values
    for i := 0 to ColCount - 1 do
      for k := 0 to RowCount - 1 do
      begin
        Readln(f, strTemp);
        Cells[i, k] := strTemp;
      end;
  end;
  CloseFile(f);
end;


// Save StringGrid1 to 'c:\temp.txt':

procedure TForm1.Button1Click(Sender: TObject);
var
 i : Integer ;
 TableName : String;

begin
 TableName := 'Person' ;

 for i := 1 to StringGrid1.RowCount-1 do
              try
                 with DataModule1.FDQuery1 do
                    begin
                          Close;
                          SQL.Clear;
                                SQL.Text :='Insert Into '+TableName+
                          ' Values( :Val1 , :Val2    , :Val3 ,  :Val4   , :Val5 )' ;

                          Params.ParamByName('Val1').Value := StringGrid1.Cells[0,i];
                          Params.ParamByName('Val2').Value := StringGrid1.Cells[1,i] ;
                          Params.ParamByName('Val3').Value := StringGrid1.Cells[2,i] ;
                          Params.ParamByName('Val4').Value := StringGrid1.Cells[3,i];
                          Params.ParamByName('Val5').Value := StringGrid1.Cells[4,i] ;
                          ExecSQL;

                          Close;
                    end;
              except on E: Exception do

              end;


end;

procedure TForm1.Button2Click(Sender: TObject);
  var
 i , j : Integer;

begin
FileOpenDialog1.Execute();

 //// Load Excel To StingGrid
 ///

 if Xls_To_StringGrid(StringGrid1, FileOpenDialog1.FileName) then
  Button2.Caption := 'Load Excel File Complate' ;


 ////  If Cell Is Null Or Empety With This Code The Cell Value = 0 .
 ///
  for I := 0 to StringGrid1.RowCount-1 do
     for j := 0 to StringGrid1.ColCount-1 do
        begin
              if StringGrid1.Cells[j,i].IsEmpty = true then
                  StringGrid1.Cells[j,i]  := '0';
        end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

function TForm1.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;

end.

 

دانلود سورس کد

 

کلمات کلیدی

:تاریخ شمسی, میلادی , تبدیل تاریخ میلادی به شمسی ,
دلفی,ورژن,پاسکال,DVD,Rom,Open and Close DVD Rom,Driver
Delphi,Program,Pascal,File,Version,Compile,Double, Time ,Date,Return , String,Grid,Excel,Import,Export,Table,Save,Import Excel To Delphi,Export StringGrid To Table


چاپ