[jmrl11]

Столкнулся с проблемой: необходимо получить данные их Excel и записать их в матрицу для дальнейшей работы. Файл имеет порядка 30 листов(20-40), данные - целые числа, упорядочены одинаково на каждом листе (12столбцов и 31строка). Нужно данные каждого листа записать в одномерный массив, по столбцам, т.е. сначала все элементы первого столбца, второго и т.д. хотя это уже не суть важно, главное записать их к какой-нибудь массив (преобразовать его в нужный одномерный не составит труда). Для пользователя это должно выглядеть максимально просто: файл>открыть>путь к файлу и какой-то выпадающий список(ComboBox) где можно выбрать имя листа(в частности имена листов это годы) с данными которого нужно будет работать.
Подскажите как это сделать.

[~ SaM ~]

Получаем список листов в книге:

Код:

Function  GetSheets(value:TStrings):boolean;
 var a_:integer;
begin
GetSheets:=true;
value.Clear;
try
for a_:=1 to E.ActiveWorkbook.Sheets.Count do
    value.Add(E.ActiveWorkbook.Sheets.Item[a_].Name);
except
GetSheets:=false;
value.Clear;
end;
End;

Выбираем необходимый лист.

Код:

Function  SelectSheet(sheet:variant):boolean;
begin
SelectSheet:=true;
try
E.ActiveWorkbook.Sheets.Item[sheet].Select
except
SelectSheet:=false;
end;
End;

Использование:

Код:

GetSheets(Combobox1.Items);
SelectSheet(Combobox1.Items.Strings[]);

[jmrl11]

Можно подробнее, а то я не имею понятия о обмене данными с Excel. Судя по всему необходимо использовать компонент TExcelApplication? А каким образом получить данные из Excel'a и записать их в матрицу?

[Max7]

Где-то на http://berega-next.ru я видел, давно правда, подходящий компонент LExcel который можно просто под это использовать.
Кажется. Давно это было. Но у меня он должен быть.

[jmrl11]

Сообщение от Max7

Где-то на http://berega-next.ru я видел, давно правда, подходящий компонент LExcel который можно просто под это использовать.
Кажется. Давно это было. Но у меня он должен быть.

был бы премного благодарен если бы ты его поискал и нашел, т.к. сайт http://berega-next.ru на реконструкции)

[Max7]

Нет, ошибся. LExcel для переноса таблицы базы данных в Excel.

Но есть чей-то пример очень наглядный работы с Excel:

unit Unit1;
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Запуск и закрытие Excel, добавление и удаление книг и листов

На данный момент работает:
- вызов и закрытие Excel
- добавление новых, открытие ранее созданных и удаление рабочих книг
- добавление и удаление листов в рабочие книги

Зависимости: ComObj, SysUtils,Dialogs,Controls;
Автор: lookin, lookin@mail.ru, Екатеринбург
Copyright: lookin
Дата: 04 мая 2002 г.
************************************************** *** }
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ComObj, Dialogs,
StdCtrls;


type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Excel: Variant;

procedure CallExcel(Show: boolean);
procedure CloseExcel;
procedure AddWorkBook(WorkBookName: Ansistring);
procedure OpenWorkBook(WorkBookName: Ansistring);
procedure CloseWorkBook(WorkBookName: Ansistring);
procedure ActivateWorkBook(WorkBookName: Ansistring);
procedure ActivateWorkSheet(WorkBookName, WorkSheetName: Ansistring);
function WorkBookIndex(WorkBookName: Ansistring): integer;
function WorkSheetIndex(WorkBookName, WorkSheetName: Ansistring): integer;
procedure CheckExtension(Name: Ansistring);
procedure AddWorkSheet(WorkBookName, WorkSheetName: Ansistring);
procedure DeleteWorkSheet(WorkBookName, WorkSheetName: Ansistring);

implementation

{$R *.dfm}


procedure CallExcel(Show: boolean);
begin
if VarIsEmpty(Excel) = true then
begin
Excel := CreateOleObject('Excel.Application');
if Show then
Excel.Visible := true;
end;
end;

procedure CloseExcel;
begin
if VarIsEmpty(Excel) = false then
begin
Excel.Quit;
Excel := 0;
end;
end;

procedure AddWorkBook(WorkBookName: Ansistring);
var
k: integer;
begin
CheckExtension(WorkBookName);
if VarIsEmpty(Excel) = true then
begin
Excel := CreateOleObject('Excel.Application');
Excel.Visible := true;
end;
k := WorkBookIndex(WorkBookName);
if k = 0 then
begin
Excel.Workbooks.Add;
Excel.ActiveWorkbook.SaveCopyAs(FileName := WorkBookName);
Excel.ActiveWorkbook.Close;
Excel.Workbooks.Open(WorkBookName);
end
else
MessageDlg('Книга с таким именем уже существует.', mtWarning, [mbOk], 0);
end;

procedure OpenWorkBook(WorkBookName: Ansistring);
var
k: integer;
begin
CheckExtension(WorkBookName);
if VarIsEmpty(Excel) = true then
begin
Excel := CreateOleObject('Excel.Application');
Excel.Visible := true;
end;
k := WorkBookIndex(WorkBookName);
if k = 0 then
Excel.Workbooks.Open(WorkBookName)
else
MessageDlg('Книга с таким именем уже открыта.', mtWarning, [mbOk], 0);
end;

procedure CloseWorkBook(WorkBookName: Ansistring);
var
k: integer;
begin
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
if k <> 0 then
Excel.ActiveWorkbook.Close(WorkBookName)
else
MessageDlg('Книга с таким именем отсутствует.', mtWarning, [mbOk], 0);
end;
end;

procedure ActivateWorkBook(WorkBookName: Ansistring);
var
k: integer;
begin
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
if k <> 0 then
Excel.WorkBooks[k].Activate;
end;
end;

procedure ActivateWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
k, j: integer;
begin
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
j := WorkSheetIndex(WorkBookName, WorkSheetName);
if j <> 0 then
Excel.WorkBooks[k].Sheets[j].Activate;
end;
end;

procedure AddWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
k, j: integer;
begin
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
if k <> 0 then
begin
Excel.DisplayAlerts := False;
Excel.Workbooks[k].Sheets.Add;
j := WorkSheetIndex(WorkBookName, WorkSheetName);
if j = 0 then
Excel.Workbooks[k].ActiveSheet.Name := WorkSheetName;
end;
end;
end;

procedure DeleteWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
k, j: integer;
begin
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
Excel.DisplayAlerts := false;
j := WorkSheetIndex(WorkBookName, WorkSheetName);
if j <> 0 then
Excel.Workbooks[k].Sheets[j].Delete
else
MessageDlg('Листа с таким именем в этой книге нет.', mtWarning, [mbOk],
0);
end;
end;

procedure CheckExtension(Name: Ansistring);
var
s: string;
begin
//проверка расширения
s := ExtractFileExt(Name);
if LowerCase(s) <> '.xls' then
if
MessageDlg('Вы задали имя книги с нестандартным расширением. Продолжить?',
mtWarning, [mbYes, mbCancel], 0) = mrCancel then
Abort;
end;

function WorkBookIndex(WorkBookName: Ansistring): integer;
var
i, n: integer;
begin
//проверка на наличие книги с этим именем
n := 0;
if VarIsEmpty(Excel) = false then
for i := 1 to Excel.WorkBooks.Count do
if Excel.WorkBooks[i].FullName = WorkBookName then
begin
n := i;
break;
end;
WorkBookIndex := n;
end;

function WorkSheetIndex(WorkBookName, WorkSheetName: Ansistring): integer;
var
i, k, n: integer;
begin
//проверка на наличие листа с этим именем в книге с этим именем
n := 0;
if VarIsEmpty(Excel) = false then
begin
k := WorkBookIndex(WorkBookName);
for i := 1 to Excel.WorkBooks[k].Sheets.Count do
if Excel.WorkBooks[k].Sheets[i].Name = WorkSheetName then
begin
n := i;
break;
end;
end;
WorkSheetIndex := n;
end;


//Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
begin
//вызов Excel, true - если хотите при вызове Excel отобразить окно Excel
CallExcel(true);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//добавление новой рабочей книги с заданным именем
//ВАЖНО: используйте полное имя рабочей книги, т.е. включая путь
AddWorkBook(ExtractFilePath(ParamStr(0))+'qwerty.x ls');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//добавление листа с именем ff в рабочую книгу qwerty.xls
AddWorksheet(ExtractFilePath(ParamStr(0))+'qwerty. xls', 'ff');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
//активация рабочей книги 1234.xls
ActivateWorkBook(ExtractFilePath(ParamStr(0))+'123 4.xls');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
//активация листа в рабочей книге qwerty.xls
ActivateWorkSheet(ExtractFilePath(ParamStr(0))+'qw erty.xls', 'ff');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
//открытие рабочей книги qwerty.xls
OpenWorkBook(ExtractFilePath(ParamStr(0))+'qwerty. xls');
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
//закрытие рабочей книги qwerty.xls
CloseWorkBook(ExtractFilePath(ParamStr(0))+'qwerty .xls');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
//удаление листа ff из рабочей книги qwerty.xls
DeleteWorkSheet(ExtractFilePath(ParamStr(0))+'qwer ty.xls', 'ff');
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
//закрытие Excel
CloseExcel;
end;


end.

[jmrl11]

пример хороший, но немножко не точто мне нужно

[jmrl11]

Нашел подробное описание WordApplication и ExcelApplication - http://forum.vingrad.ru/forum/topic-84634.html - там раскрыты основные вопросы которые меня интересуют. Если кто-то столкнется с подобной проблемой - советую заглянуть по ссылке, возможно вы найдете ответ.

[jmrl11]

Сообщение от ~ SaM ~

Получаем список листов в книге:

Код:

Function  GetSheets(value:TStrings):boolean;
 var a_:integer;
begin
GetSheets:=true;
value.Clear;
try
for a_:=1 to E.ActiveWorkbook.Sheets.Count do
    value.Add(E.ActiveWorkbook.Sheets.Item[a_].Name);
except
GetSheets:=false;
value.Clear;
end;
End;

Выбираем необходимый лист.

Код:

Function  SelectSheet(sheet:variant):boolean;
begin
SelectSheet:=true;
try
E.ActiveWorkbook.Sheets.Item[sheet].Select
except
SelectSheet:=false;
end;
End;

Использование:

Код:

GetSheets(Combobox1.Items);
SelectSheet(Combobox1.Items.Strings[]);

Можно подробнее о этих функциях? Что такое E в E.ActiveWorkbook.Sheets.Count и т.д.?

[Max7]

Здесь перебираем все листы в книге. Заходим на каждый лист и выбираем оттуда данные:

//кусок из какой-то проги:


procedure TfrmMsg.GetFromEXCEL(Sender: TObject);
var
Title: string;
i: integer;
begin
Start := 1;


//
// ExcelApp.WorkBooks[Book].Activate;
// перебираем все листки :
for i := Start to ExcelApp.WorkBooks[Book].Sheets.Count do
begin
Title:= ExcelApp.WorkBooks[Book].Sheets[i].Name;
if Title = 'New' then Continue; // пропустить бланк-шаблон
GetTable(Book, i); // <<--------------------------------- Вот ТУТ
StaticText1.Caption := Format('Records : %8d List "'+ Title+'"', [Cont]);
StaticText1.Refresh;
Application.ProcessMessages;
end;
// Закр. EXCEL:
Escape(Sender);
end;



function TfrmMsg.GetTable(Book, Index: integer): boolean;
var
Sht: OleVariant;
V: TZwit;
MaxCNT: integer; // наибольшее кол-во строк в листе
DD: string;
ZLC, FP, K: string[15];
Adv: string[5];
r, c: integer;
FPd, Kurs: Double;

begin
Result:= false;
Kurs:= 0;
Cont:= 0;
DecimalSeparator:= '.';
Sht:= ExcelApp.WorkBooks[Book].Sheets[Index];
V.Title:= Sht.Name;
V.Zwit:= Index;
MaxCNT:= GetMaxRows;
// Перебираем все строчки:
for r := 2 to MaxCNT do
begin
DD:= Trim(Sht.Cells[r, 1]); // Дата
ZLC:= Trim(Sht.Cells[r, 2]); // название
FP:= Trim(StringReplace(Sht.Cells[r, 5], ',', '.', [rfReplaceAll])); // тут должна быть сумма
Val(FP, FPd, c);
// Теперь проверим наличие данных:
if (AnsiUpperCase(DD) <> 'ДАТА') and
(AnsiUpperCase(DD) <> 'ВСЬОГО:') and
(ZLC <> '') and
(FP <> '') and
(c = 0) and ( Sht.Cells[r, 1].Interior.Color = $FFFFFF )
then
begin
// Читаємо их из строчки:
//
// Дата:
if Length(DD)>2 then
try
V.ZDate:= StrToDate(DD);
except
// Sht.Cells[r, 1].Interior.Color := RGB(223, 123, 123);
if Pos(' ', DD) = 3 then DD:= StringReplace(DD, ' ', '.', [rfReplaceAll]);
ExcelApp.Visible:= false;
if InputQuery('Исправь дату', 'Листок "' +V.Title+'" строчка ' +IntToStr(r) +#10#13+
ErrStr+'дату "'+DD+'" ['+IntToStr(c)+']', DD)
then V.ZDate:= StrToDate(DD)
else V.ZDate:= StrToDate('09.07.2005');
end;
// Название ZLC :
V.ZLC:= ZLC;
// Цена:
V.Price:= ConvertStrToNumber(3, '"Price"');
// Скидка:
V.Bonus:= ConvertStrToNumber(4, '"Bonus"');
// К оплате:
V.ForPay:= FPd;
// UAH :
V.UAH:= ConvertStrToNumber(6, '"UAH"');
// USD :
V.USD:= ConvertStrToNumber(7, '"USD"');
// EUR :
V.EUR:= ConvertStrToNumber(8, '"EUR"');
// kUSD :
V.kUSD:= ConvertStrToNumber(9, '"kUSD" ');
// kEUR :
V.kEUR:= ConvertStrToNumber(10, '"kUAH"');
// Долг :
V.Debt:= ConvertStrToNumber(11, '"ДОЛГ"');
// Note :
V.Note:= Trim(Sht.Cells[r, 12]);

(* Sht.Cells[r, 2].Interior.Color := RGB(223, 123, 123);
ExcelApp.Visible:= true;
ShowMessage('"'+V.Title+'" Line '+IntToStr(r)+#10#13+ErrStr+'"OID" "'+V.ZLC+'" ['+IntToStr(c)+']'); *)
//
// Внести в базу :
Result:= SetToDataBase(V);
if Result then Inc(Cont); // счетчик записей
Application.ProcessMessages;
end;
end;
end;


И еще всякое:
ExcelApp.Workbooks.Add(xlWBatWorkSheet); // Add a new Workbook,
ExcelApp.Workbooks.Open('c:\YourFileName.xls'); // Open a Workbook,
ExcelApp.ActiveSheet.Name := 'This is Sheet 1'; // Rename the active Sheet
ExcelApp.Workbooks[1].WorkSheets[1].Name := 'This is Sheet 1'; // Rename
ExcelApp.Cells[1, 1].Value := 'SwissDelphiCenter.ch'; // Insert some Text in some Cells[Row,Col]
ExcelApp.Cells[2, 1].Value := 'http://www.swissdelphicenter.ch';
ExcelApp.Cells[3, 1].Value := FormatDateTime('dd-mmm-yyyy', Now);
ExcelApp.Range['A2', 'D2'].Value := VarArrayOf([1, 10, 100, 1000]); // Setting a row of data with one call
ExcelApp.Range['A11', 'A11'].Formula := '=Sum(A1:A10)'; // Setting a formula
ExcelApp.Cells[2, 1].HorizontalAlignment := xlRight; // Change Cell Alignement
//Можно ещё и так изменить цвет диапазона ячеек
ExcelApp.Range['B2', 'C6'].Interior.Color := RGB(223, 123, 123);
// Change the Column Width:
ColumnRange := ExcelApp.Workbooks[1].WorkSheets[1].Columns;
ColumnRange.Columns[1].ColumnWidth := 20;
ColumnRange.Columns[2].ColumnWidth := 40;
// Change Rowheight
ExcelApp.Rows[1].RowHeight := 15.75;
// Merge cells:
ExcelApp.Range['B33'].Mergecells := True;
// Apply borders to cells:
ExcelApp.Range['A14:M14'].Borders.Weight := xlThick; // Think line/ Dicke Linie
ExcelApp.Range['A14:M14'].Borders.Weight := xlThin; // Thin line Dunne Linie
// Set Bold Font in cells:
ExcelApp.Range['B16:M26'].Font.Bold := True;
// Set Font Size:
ExcelApp.Range['B16:M26'].Font.Size := 12;
//right-aligned Text:
ExcelApp.Cells[9, 6].HorizontalAlignment := xlRight;
// horizontal-aligned text:
ExcelApp.Range['B14:M26'].HorizontalAlignment := xlHAlignCenter;
// left-aligned Text:
ExcelApp.Range['B14:M26'].VerticalAlignment := xlVAlignCenter;
(* Page Setup *)
ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;
// Left, Right Margin (Seitenrander)
ExcelApp.ActiveSheet.PageSetup.LeftMargin := 35;
ExcelApp.ActiveSheet.PageSetup.RightMargin := -15;
// Set Footer Margin
ExcelApp.ActiveSheet.PageSetup.FooterMargin := ExcelApp.InchesToPoints(0);
// Fit to X page(s) wide by Y tall
ExcelApp.ActiveSheet.PageSetup.FitToPagesWide := 1; // Y
ExcelApp.ActiveSheet.PageSetup.FitToPagesTall := 3; // Y
// Zoom
ExcelApp.ActiveSheet.PageSetup.Zoom := 95;
// Set Paper Size:
ExcelApp.PageSetup.PaperSize := xlPaperA4;
// Show/Hide Gridlines:
ExcelApp.ActiveWindow.DisplayGridlines := False;
// Set Black & White
ExcelApp.ActiveSheet.PageSetup.BlackAndWhite := False;
// footers
ExcelApp.ActiveSheet.PageSetup.RightFooter := 'Right Footer' ;
ExcelApp.ActiveSheet.PageSetup.LeftFooter := 'Left Footer' ;
// Show Excel Version:
ShowMessage(Format('Excel Version %s: ', [ExcelApp.Version]));
// Show Excel:
ExcelApp.Visible := True;
// Save the Workbook
ExcelApp.SaveAs('c:\filename.xls');
// Save the active Workbook:
ExcelApp.ActiveWorkBook.SaveAs('c:\filename.xls');
// Поворачивать слова, писать вертикально, под углом и т.д.:
XL.WorkBooks[1].WorkSheets[1].Rows[2].Orientation := 90;
XL.WorkBooks[1].WorkSheets[1].Range['A2:B2'].Orientation := 0;
//подогнать ширину столбцов по содержимому:
WorkBook.WorkSheets[1].Columns.Item[i].Autofit;
}

[Max7]

А в примерах от ~ SaM ~ E это тоже, что в моих примерах
переменная
Excel: Variant;

и далее

Excel := CreateOleObject('Excel.Application');

[jmrl11]

Код:

RangeMatrix : Variant
...

RangeMatrix := XLApp.Range['A1',XLApp.Cells.Item[X,Y]].Value2;
repeat
    for R := 1 to Y do
      StringGrid1.Cells[(R),(K)] := RangeMatrix[K,R];
      Inc(K,1);
    StringGrid1.RowCount := K + 1;
  until
   K > X;

Сопоставляем матрицу WorkSheet с нашей Delphi матрицей и определяем цикл для заполнения TStringGrid. В результате имею заполенный StringGrid1 данными листа и хочу преобразовать данные в простой одномерный массив целочисленного типа (все данные целые числа).

Код:

...
OM[1]:= strtoint(StringGrid1.Cells[(1),(1)]);
...

Материться по поводу не совпадения типов. Если пытаюсь преобразовать сразу variant в integer c помощью:

Код:

function VarToInt(var AVariant: variant; DefaultValue: integer = 0): integer;
begin
   Result := DefaultValue;
  if VarIsNull(AVariant) then
    Result := 0
  else
    if VarIsOrdinal(AVariant) then
      Result := StrToInt(VarToStr(AVariant));
end;

Код:

...
OM[i]:=VarToInt(RangeMatrix[K,R]);
...
 

имею тот же результат - типы не совпадают...

[Max7]

Вот работающая программа чтения матрицы и вывода ее на StringGrid.
Могу прогу на мыло выслать