|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Работа с xls файлами
Столкнулся с проблемой: необходимо получить данные их Excel и записать их в матрицу для дальнейшей работы. Файл имеет порядка 30 листов(20-40), данные - целые числа, упорядочены одинаково на каждом листе (12столбцов и 31строка). Нужно данные каждого листа записать в одномерный массив, по столбцам, т.е. сначала все элементы первого столбца, второго и т.д. хотя это уже не суть важно, главное записать их к какой-нибудь массив (преобразовать его в нужный одномерный не составит труда). Для пользователя это должно выглядеть максимально просто: файл>открыть>путь к файлу и какой-то выпадающий список(ComboBox) где можно выбрать имя листа(в частности имена листов это годы) с данными которого нужно будет работать.
Подскажите как это сделать. |
#2
|
|||
|
|||
Получаем список листов в книге:
Код:
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[]); |
#3
|
|||
|
|||
Можно подробнее, а то я не имею понятия о обмене данными с Excel. Судя по всему необходимо использовать компонент TExcelApplication? А каким образом получить данные из Excel'a и записать их в матрицу?
|
#4
|
|||
|
|||
Где-то на http://berega-next.ru я видел, давно правда, подходящий компонент LExcel который можно просто под это использовать.
Кажется. Давно это было. Но у меня он должен быть. |
#5
|
|||
|
|||
Цитата:
|
#6
|
|||
|
|||
Нет, ошибся. 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. |
#7
|
|||
|
|||
пример хороший, но немножко не точто мне нужно
|
#8
|
|||
|
|||
Нашел подробное описание WordApplication и ExcelApplication - http://forum.vingrad.ru/forum/topic-84634.html - там раскрыты основные вопросы которые меня интересуют. Если кто-то столкнется с подобной проблемой - советую заглянуть по ссылке, возможно вы найдете ответ.
|
#9
|
|||
|
|||
Цитата:
|
#10
|
|||
|
|||
Здесь перебираем все листы в книге. Заходим на каждый лист и выбираем оттуда данные:
//кусок из какой-то проги: 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; } |
#11
|
|||
|
|||
А в примерах от ~ SaM ~ E это тоже, что в моих примерах
переменная Excel: Variant; и далее Excel := CreateOleObject('Excel.Application'); |
#12
|
|||
|
|||
Код:
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; Код:
... OM[1]:= strtoint(StringGrid1.Cells[(1),(1)]); ... Код:
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]); ... |
#13
|
|||
|
|||
Вот работающая программа чтения матрицы и вывода ее на StringGrid.
Могу прогу на мыло выслать |