mahdy.asia
سه شنبه 07 آبان 1392, 17:26 عصر
من کد اکسپورت اطلاعات به اکسل رو در دلفی 7 نوشته بودم الان سورس رو انتقال دادم به دلفی XE2 خط زیر خطا می دهد.
DataType را بر نمی گرداند تا مقایسه درست انجام گردد (
StringType : Set of TFieldType = [ftString, ftWideString, ftFixedChar]; )
اشکال در خط
if MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).DataType in StringType then
کل کد :
procedure TF_ParentMain.DBGridSaveToExcelFile(MyDBGrid : TMTBI_DBGrid);
var
i, j : Integer;
Sheet : Variant;
RecCount : integer;
ColCount : integer;
ColIndex : integer;
ColumnRange: Variant;
Range: Variant;
StrRange : String;
XLApp: Variant;
begin
GlobalDBGrid := MyDbGrid;
if MyDBGrid = nil then exit;
if MyDBGrid.DataSource = nil then exit;
if MyDBGrid.DataSource.DataSet = nil then exit;
if MyDBGrid.DataSource.DataSet.Active = False then exit;
if MyDBGrid.DataSource.DataSet.RecordCount = 0 then exit;
RecCount := MyDBGrid.DataSource.DataSet.RecordCount;
ColCount := 0;
for i := 0 to MyDBGrid.Columns.Count - 1 do
if MyDBGrid.Columns[i].Visible then
ColCount := ColCount + 1;
XLApp:= CreateOleObject('Excel.Application');
XLApp.Visible := True;
XLApp.Workbooks.Add(1);
XLApp.Workbooks[1].WorkSheets[1].Name := 'Delphi Data';
ColumnRange := XLApp.Workbooks[1].WorkSheets['Delphi Data'].Columns;
if ColCount <= 26 then
StrRange := 'A1:' + UpperCase(Char(ColCount+ 64)) + '1'
else
if ColCount <= 52 then
StrRange := 'A1:' + 'A' + UpperCase(Char(ColCount+ 64 - 26)) + '1'
else
if ColCount <= 78 then
StrRange := 'A1:' + 'B' + UpperCase(Char(ColCount+ 64 - 52)) + '1'
else
if ColCount <= 96 then
StrRange := 'A1:' + 'C' + UpperCase(Char(ColCount+ 64 - 78)) + '1';
Range := XLApp.Workbooks[1].WorkSheets['Delphi Data'].Range[StrRange];
Range.Columns.Interior.ColorIndex := 8;
MyDBGrid.DataSource.DataSet.First;
MyDBGrid.DataSource.DataSet.DisableControls;
Sheet := XLApp.Workbooks[1].WorkSheets['Delphi Data'];
ColIndex := 1;
for j := 1 TO MyDBGrid.Columns.Count do
if MyDBGrid.Columns[j-1].Visible then
begin
Sheet.Cells[1, ColIndex] := MyDBGrid.Columns[j-1].Title.Caption;
ColumnRange.Columns[ColIndex].ColumnWidth := 25;
ColumnRange.Columns.Item[ColIndex].Font.Bold := True;
ColumnRange.Columns[ColIndex].Font.Color := clBlue;
ColIndex := ColIndex + 1;
end;
While Not MyDBGrid.DataSource.DataSet.Eof do
begin
ColIndex := 1;
for j := 1 TO MyDBGrid.Columns.Count do
if MyDBGrid.Columns[j-1].Visible then
begin
if MyDBGrid.DataSource.DataSet.FindField(MyDBGrid.Col umns[j-1].FieldName) <> nil then
if Not MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).IsNull then
begin
if MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).DataType in StringType then
Sheet.Cells[MyDBGrid.DataSource.DataSet.RecNo + 1, ColIndex].NumberFormat := '@'; // General
Sheet.Cells[MyDBGrid.DataSource.DataSet.RecNo + 1, ColIndex] := MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).Value;
end;
ColIndex := ColIndex + 1;
end;
MyDBGrid.DataSource.DataSet.Next;
end;
MyDBGrid.DataSource.DataSet.EnableControls;
end;
DataType را بر نمی گرداند تا مقایسه درست انجام گردد (
StringType : Set of TFieldType = [ftString, ftWideString, ftFixedChar]; )
اشکال در خط
if MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).DataType in StringType then
کل کد :
procedure TF_ParentMain.DBGridSaveToExcelFile(MyDBGrid : TMTBI_DBGrid);
var
i, j : Integer;
Sheet : Variant;
RecCount : integer;
ColCount : integer;
ColIndex : integer;
ColumnRange: Variant;
Range: Variant;
StrRange : String;
XLApp: Variant;
begin
GlobalDBGrid := MyDbGrid;
if MyDBGrid = nil then exit;
if MyDBGrid.DataSource = nil then exit;
if MyDBGrid.DataSource.DataSet = nil then exit;
if MyDBGrid.DataSource.DataSet.Active = False then exit;
if MyDBGrid.DataSource.DataSet.RecordCount = 0 then exit;
RecCount := MyDBGrid.DataSource.DataSet.RecordCount;
ColCount := 0;
for i := 0 to MyDBGrid.Columns.Count - 1 do
if MyDBGrid.Columns[i].Visible then
ColCount := ColCount + 1;
XLApp:= CreateOleObject('Excel.Application');
XLApp.Visible := True;
XLApp.Workbooks.Add(1);
XLApp.Workbooks[1].WorkSheets[1].Name := 'Delphi Data';
ColumnRange := XLApp.Workbooks[1].WorkSheets['Delphi Data'].Columns;
if ColCount <= 26 then
StrRange := 'A1:' + UpperCase(Char(ColCount+ 64)) + '1'
else
if ColCount <= 52 then
StrRange := 'A1:' + 'A' + UpperCase(Char(ColCount+ 64 - 26)) + '1'
else
if ColCount <= 78 then
StrRange := 'A1:' + 'B' + UpperCase(Char(ColCount+ 64 - 52)) + '1'
else
if ColCount <= 96 then
StrRange := 'A1:' + 'C' + UpperCase(Char(ColCount+ 64 - 78)) + '1';
Range := XLApp.Workbooks[1].WorkSheets['Delphi Data'].Range[StrRange];
Range.Columns.Interior.ColorIndex := 8;
MyDBGrid.DataSource.DataSet.First;
MyDBGrid.DataSource.DataSet.DisableControls;
Sheet := XLApp.Workbooks[1].WorkSheets['Delphi Data'];
ColIndex := 1;
for j := 1 TO MyDBGrid.Columns.Count do
if MyDBGrid.Columns[j-1].Visible then
begin
Sheet.Cells[1, ColIndex] := MyDBGrid.Columns[j-1].Title.Caption;
ColumnRange.Columns[ColIndex].ColumnWidth := 25;
ColumnRange.Columns.Item[ColIndex].Font.Bold := True;
ColumnRange.Columns[ColIndex].Font.Color := clBlue;
ColIndex := ColIndex + 1;
end;
While Not MyDBGrid.DataSource.DataSet.Eof do
begin
ColIndex := 1;
for j := 1 TO MyDBGrid.Columns.Count do
if MyDBGrid.Columns[j-1].Visible then
begin
if MyDBGrid.DataSource.DataSet.FindField(MyDBGrid.Col umns[j-1].FieldName) <> nil then
if Not MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).IsNull then
begin
if MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).DataType in StringType then
Sheet.Cells[MyDBGrid.DataSource.DataSet.RecNo + 1, ColIndex].NumberFormat := '@'; // General
Sheet.Cells[MyDBGrid.DataSource.DataSet.RecNo + 1, ColIndex] := MyDBGrid.DataSource.DataSet.FieldByName(MyDBGrid.C olumns[j-1].FieldName).Value;
end;
ColIndex := ColIndex + 1;
end;
MyDBGrid.DataSource.DataSet.Next;
end;
MyDBGrid.DataSource.DataSet.EnableControls;
end;