Примеры работы с MS Excel

== Пример импорта прайс-листа ===
в секции uses стоит так ExcelXP,{Excel2000, Excel97} крайней мере у меня, т.к. некоторые параметры при работе с разными версиями отличаются, например при открытии файла в версии XP больше параметров, чем в версии `97.
На форме лежит компонента Ex1 типа TExcelApplication со страницы Servers, свойства AutoConnect и AutoQuit :=False, свойство ConnectKind:=ckRunningOrNew,
uses
 ExcelXP, OleServer, ComObj;
{
Ex1 - TExcelApplication со страницы Servers
dm - TDataModule
tArrivalDet, tPreparats, tArrival - TpFibDataBase
считаю, что такие функции, как DelProb или FindPreparat не требуется сюда выкладывать, т.к. у всех своя специфика, тем
более, что они никакого отношения не имеют к импорт из Excel
}
procedure TfmImpFromExcel.ImportArrivalFromExcel(FileName: String);
var
 WorkBk: _WorkBook; // определяем WorkBook
 WorkSheet: _WorkSheet; // определяем WorkSheet
 Range: OleVariant;
 iUnitID, iUnit, iAmount, iTerm, iPrepID, iSeries, iStop, iProd, iPrice, RowsToCopy, iLastRow, iWBIndex, x, iBook, iNameRow: Integer;
 sInvoiceNum, sUnitCol, sAmountCol, sTermCol, sProdCol, sPriceCol, sNameCol, sSeriesCol, sFileName: String;
 bNaydeno7, bNaydeno6, bNaydeno5, bNaydeno4, bNaydeno2, bNaydeno1, bNaydeno, bNaydeno3: Boolean;
 vPrep: Variant;
 НайденоВБазе, НеНайденоВБазе: Integer;
 Препарат, Производитель, Серия, Единица: String;
 ЦенабНДС, НДС, ЦенаСНДС: Real;
 ArrivalID: Integer;
begin
 sFileName := ;
 screen.Cursor := crHourGlass;
 try
 sInvoiceNum := AnsiUpperCase(ExtractFileName(FileName));
 sInvoiceNum := Copy(sInvoiceNum, 1, Pos('.XLS',sInvoiceNum)-1);
 fmNewArrival.edInvoice_num.Text := sInvoiceNum;
 dm.tPreparats.DisableControls;
 dm.tPreparats.AutoCommit := False;
 if not dm.tArrivalDet.active then
 dm.tArrivalDet.Open;
 dm.tArrivalDet.DisableControls;
 dm.tArrivalDet.AutoCommit := False;
 dm.tArrivalDet.BeforeInsert := nil;
 dm.tArrivalDet.AfterPost := nil;
 НеНайденоВБазе := 0;
 НайденоВБазе := 0;
 try // попытка открытия файла
 Ex1.Connect;
 Ex1.Workbooks.Open(FileName, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
 EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
 EmptyParam, EmptyParam, EmptyParam, LOCALE_USER_DEFAULT);
 Ex1.Application.EnableEvents := False;
 except // в случае ошибки все отменяем и обнуляем
 screen.Cursor := crDefault;
 RowsToCopy := 0;
 exit;
 end; // try-except Ex1.Connect
 sFileName := ExtractFileName(FileName);
 for iWBIndex := 1 to ex1.Workbooks.Count do
 if ex1.Workbooks.Item[iWBIndex].Name = sFileName then break;
 WorkBk := ex1.WorkBooks.Item[iWBIndex]; // Выбираем WorkBook
 // Определяем WorkSheet
 if WorkBk.Worksheets.Count > 1 then
 begin // если кол-во листов больше 1
 for x := 0 to memoSheets.Lines.Count-1 do
 begin
 for iBook := 1 to WorkBk.Worksheets.Count do
 begin
 WorkSheet := WorkBk.WorkSheets.Get_Item(iBook) as _WorkSheet;
 if WorkSheet.Name = memoSheets.Lines[x] then
 begin
 bNaydeno3 := True; // нашли лист
 WorkSheet.Activate(LOCALE_USER_DEFAULT); // активируем лист
 end;
 if bNaydeno3 then break;
 end;
 if bNaydeno3 then break;
 end;
 // если не находим лист из списка ключевых слов, выдаем сообщение
 if not bNaydeno3 then
 begin
 beep;
 ShowMessage('<Не найден лист с данными>'+#13+#13+
 '1.Откройте прайс, посмотрите название листа с препаратами, добавьте в'+#13+
 'ключевые слова название листа с препаратами и повторите импорт'+#13+
 '___________________________________________________________________________________'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить и закройте Excel"');
 exit;
 end; // if bNaydeno3=false then begin
 end
 else
 WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;;
 StatusBar1.Panels[0].Text := 'Поиск последней строки...';
 Application.ProcessMessages;
 if Find('99999', iNameRow, sNameCol, WorkSheet) then
 begin
 iLastRow:=iNameRow-1; // в столбце с наименованием ищем "99999"-конец импорта
 end
 else
 begin // и запоминаем в iRows
 try // если не находим 99999 то ищем последнюю заполненную ячейку
 WorkSheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 // Получаем значение последней строки
 iLastRow := (ex1.ActiveCell.Row)-1;
 except
 try
 WorkSheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Select;
 // Получаем значение последней строки
 iLastRow := (ex1.ActiveCell.Row);
 except
 iLastRow := 0;
 end;
 end;
 end; // else
 if iLastRow = 0 then
 begin
 memoErrors.Lines.Add(TimeToStr(Time) + ' Не найден признак окончания данных, импортируем 6000 строк');
 iLastRow := 6000;
 end;
 // показываем кол-во строк для копирования
 memoErrors.Lines.Add(TimeToStr(Time) + ' Записей для импорта '+IntToStr(RowsToCopy));
 // ищем наименование препаратов
 for x := 0 to memoName.Lines.Count-1 do
 begin
 bNaydeno := False;
 if Find(memoName.Lines[x], iNameRow, sNameCol, WorkSheet) then
 begin
 bNaydeno := True;
 // количество строк для копирования
 RowsToCopy := iLastRow - iNameRow;
 break;
 end;
 end;
 if not bNaydeno then
 begin
 beep;
 ShowMessage('<Не найден столбец с наименованиями>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с наименованиями,'+#13+
 'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
 '-----------------------------------------------------------------------------'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Не найден столбец с производителем препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем серию препаратов
 for x := 0 to memoSeries.Lines.Count-1 do
 begin
 bNaydeno4 := False;
 if Find(memoSeries.Lines[x], iSeries, sSeriesCol, WorkSheet) then
 begin
 bNaydeno4 := True;
 break;
 end;
 end;
 if not bNaydeno4 then
 begin
 beep;
 ShowMessage('<Не найден столбец с сериями препаратов>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с сериями препаратов, добавьте в'+#13+
 'ключевые слова название этого столбца и повторите импорт.'+#13+
 '___________________________________________________________________________________'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Не найден столбец с сериями препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем Ед. изм препаратов
 for x := 0 to memoUnits.Lines.Count-1 do
 begin
 bNaydeno7 := False;
 if Find(memoUnits.Lines[x], iUnit, sUnitCol, WorkSheet) then
 begin
 bNaydeno7 := True;
 break;
 end;
 end;
 if not bNaydeno7 then
 begin
 beep;
 ShowMessage('<Не найден столбец с единицами измерений>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с ед.изм., добавьте в'+#13+
 'ключевые слова название этого столбца и повторите импорт.'+#13+
 '___________________________________________________________________________________'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Не найден столбец с сериями препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем цену препаратов
 for x := 0 to memoPrice.lines.Count-1 do
 begin
 bNaydeno1 := False;
 if Find(memoPrice.lines[x], iPrice, sPriceCol, WorkSheet) then
 begin
 bNaydeno1 := True;
 break;
 end;
 end;
 if not bNaydeno1 then
 begin
 beep;
 ShowMessage('<Не найден столбец с ценами препаратов>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с ценами препаратов, добавьте в'+#13+
 'ключевые слова название этого столбца и повторите импорт.'+#13+
 '___________________________________________________________________________________'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Не найден столбец с ценами препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time) + ' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем количество
 for x := 0 to memoAmount.lines.Count-1 do
 begin
 bNaydeno6 := False;
 if Find(memoAmount.lines[x], iAmount, sAmountCol, WorkSheet) then
 begin
 bNaydeno6 := True;
 break;
 end;
 end;
 if not bNaydeno6 then
 begin
 beep;
 ShowMessage('<Не найден столбец "количество">'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с количеством, добавьте в'+#13+
 'ключевые слова название этого столбца и повторите импорт.'+#13+
 '___________________________________________________________________________________'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец "количество".');
 memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем производителя препаратов
 for x := 0 to memoProducer.Lines.Count-1 do
 begin
 bNaydeno2 := False;
 if Find(memoProducer.Lines[x], iProd, sProdCol, WorkSheet) then
 begin
 bNaydeno2 := True;
 break;
 end;
 end;
 if not bNaydeno2 then
 begin
 beep;
 ShowMessage('<Не найден столбец с наименованиями производителей>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца с наименованиями производителей,'+#13+
 'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
 '-----------------------------------------------------------------------------'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с производителем препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 // ищем срок годности препаратов
 for x := 0 to memoTerm.Lines.Count-1 do
 begin
 bNaydeno5 := False;
 if Find(memoTerm.Lines[x], iTerm, sTermCol, WorkSheet) then
 begin
 bNaydeno5 := True;
 break;
 end;
 end;
 if not bNaydeno5 then
 begin
 beep;
 ShowMessage('<Не найден столбец со сроком годности препаратов>'+#13+#13+
 '1.Откройте прайс, посмотрите название столбца со сроком годности,'+#13+
 'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
 '-----------------------------------------------------------------------------'+#13+
 '2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
 memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец со сроком годности препаратов.');
 memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
 memoErrors.Lines.Add('___________________________________________');
 exit;
 end;
 pb1.Max := RowsToCopy;
 StatusBar1.Panels[0].Text := 'Импорт начат...';
 Application.ProcessMessages;
 iStop := 0;
 // начинаем импорт со строки iNameRow
 Inc(iNameRow);
 for x := 0 to RowsToCopy do
 with dm do
 begin
 Препарат := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow, sNameCol].Value));
 if (Pos('ОТПУЩЕНО', AnsiUpperCase(Препарат)) <> 0) or
 (Pos('ВСЕГО', AnsiUpperCase(Препарат)) <> 0) or
 (Pos('ОПЛАТА', AnsiUpperCase(Препарат)) <> 0) or
 (Препарат = )
 then continue;
 Серия := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow, sSeriesCol].Value));
 Производитель := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow, sProdCol].Value));
 Единица := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow, sUnitCol].Value));
 if Единица = then Единица := 'шт';
 if cbWithVAT.Checked then
 begin
 ЦенабНДС := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow, sPriceCol].Value)),0);
 НДС := (ЦенабНДС * 1.2)-ЦенабНДС;
 ЦенаСНДС := ЦенабНДС + НДС;
 end
 else
 begin // без НДС
 ЦенабНДС := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow, sPriceCol].Value)),0);
 НДС := 0.00;
 ЦенаСНДС := ЦенабНДС;
 end;
 if (Препарат = ) or (Препарат = ' ')
 then
 Inc(iStop) // если пустая строка, то увеличиваем на 1
 else
 iStop := 0; // если следующая не пустая то обнуляем и продолжаем импорт
 // если начались пустые строки то прекращаем импорт
 if iStop > 4 then break;
 // наименование препарата сначала нужно найти в справочнике препаратов
 iPrepID := -1;
 ArrivalID := tArrivalID.Value;
 if (tArrival.state = dsEdit) or (tArrival.state = dsInsert) then
 begin
 tArrival.post;
 tArrival.locate('ID', ArrivalID, []);
 tArrival.edit;
 end;
 if FindPreparat(Препарат, Производитель, iPrepID) then
 begin // если нашли, то у нас есть его ID, т.е. iPrepID
 // добавляем в приход
 Inc(НайденоВБазе);
 tArrivalDet.Append;
 tArrivalDetARRIVAL_ID.Value := ArrivalID;
 tArrivalDetPREPARAT_ID.Value := iPrepID;
 tArrivalDetPRICE_WO_NDS.AsFloat := ЦенаБНДС;
 tArrivalDetPRICE_W_VAT.AsFloat := ЦенаСНДС;
 tArrivalDetVAT.AsFloat := НДС;
 tArrivalDetPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value, -2));
 tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow, sAmountCol].Value)), 0);
 tArrivalDetSERIES.AsString := Серия;
 tArrivalDetUNIT_ID.Value := FindUnit(Единица);
 tArrivalDet.Post;
 end
 else
 begin // добавляем в справочник препаратов новый препарат
 Inc(НеНайденоВБазе);
 tPreparats.Append;
 iPrepID := tPreparatsID.Value;
 tPreparatsNAME.Value := Препарат;
 tPreparatsPRODUCER.Value := Производитель;
 tPreparatsSERIES.Value := Серия;
 tPreparatsPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value,-2));
 tPreparatsPRICE_WO_VAT.AsFloat := ЦенаСНДС;
 tPreparatsTERM.Value := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sTermCol].Value));
 tPreparatsUNIT_ID.Value := FindUnit(Единица);
 tPreparats.Post;
 // а теперь добавляем его в приход
 tArrivalDet.Append;
 tArrivalDetARRIVAL_ID.Value := tArrivalID.Value;
 tArrivalDetPREPARAT_ID.Value := iPrepID;
 tArrivalDetUNIT_ID.Value := FindUnit(Единица);
 tArrivalDetPRICE_WO_NDS.AsFloat := ЦенаБНДС;
 tArrivalDetPRICE_W_VAT.AsFloat := ЦенаСНДС;
 tArrivalDetVAT.AsFloat := НДС;
 tArrivalDetPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value, -2));
 tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow, sAmountCol].Value)), 0);
 tArrivalDetUNIT_ID.Value := FindUnit(Единица);
 tArrivalDetSERIES.AsString := Серия;
 tArrivalDet.Post;
 end;
 Inc(iNameRow);
 pb1.Position := x;
 Application.ProcessMessages;
 if bAbort then
 Break;
 end; // for e:=0 to RowsToCopy do
 finally
 memoErrors.Lines.Add('Завершение импорта...');
 dm.tPreparats.EnableControls;
 dm.tArrivalDet.EnableControls;
 dm.tArrivalDet.BeforeInsert := dm.tArrivalDetBeforeInsert;
 dm.tArrivalDet.AfterPost := dm.tArrivalDetAfterPost;
 if dm.tArrivalDet.UpdateTransaction.InTransaction then dm.tArrivalDet.UpdateTransaction.Commit;
 if dm.tPreparats.UpdateTransaction.InTransaction then dm.tPreparats.UpdateTransaction.Commit;
 dm.tArrivalDet.AutoCommit := True;
 dm.tPreparats.AutoCommit := True;
 memoErrors.Lines.Add('Найдено в справочнике препаратов: ' + IntToStr(НайденоВБазе));
 memoErrors.Lines.Add('Добавлено новых в справочник препаратов: ' + IntToStr(НеНайденоВБазе));
 memoErrors.Lines.Add('Импорт завершен');
 StatusBar1.Panels[0].Text := 'Импорт завершен';
 Screen.Cursor := crDefault;
 end;
end;
function TfmImpExcel.Find(sText: String; var iRow: Integer; var sCol: String; WorkSheetF: _WorkSheet): Bool;
var
 UsedRange, Range: OLEVariant;
 t, y: Integer; // вспомогат для импорта
 FirstAddress: string;
begin //поиск начали
 Result := False;
 UsedRange := WorkSheetF.Range['A1', 'Z5000']; // диапазон поиска, например от 'F25' до 'G30'
 Range := UsedRange.Find(What := sText, LookIn := xlValues, LookAt := xlWhole, SearchDirection := xlNext);
 if not VarIsClear(Range) then
 try
 FirstAddress := Range.Address;
 // вычисляем номер строки из полученного адреса(абсолютные координаты)
 // он начинается после второго значка доллара
 // формат найденной строки, что-то типа $A$2 (абсолютные координаты)
 t := PosEx('$', FirstAddress, 2);
 iRow := StrToInt(Copy(FirstAddress, t+1, Length(FirstAddress)-t));
 // вычисляем номер столбца из полученного адреса(абсолютные координаты)
 // буква начинается со второго символа
 y := PosEx('$', FirstAddress, 2);
 sCol := Copy(FirstAddress, 2, y-2);
 Result := True;
 VarClear(Range);
 VarClear(UsedRange);
 except
 Result := False;
 end;
end;
ID: 04394
----
== Пример заполнения ячеек таблицы ===
Еще несколько примеров, используя Ole
Excel: Variant - глобальная переменная
begin
 // вначале проверяем, не открыт ли Excel и закрываем
 if not VarIsEmpty(Excel) then
 begin
 Excel.Quit;
 Excel := Unassigned;
 end;
 try // открываем Excel и создаем раб.книгу
 Excel := CreateOleObject('Excel.Application');
 // кол-во листов в новой книге
 Excel.SheetsInNewWorkbook := 1;
 // добавляем раб.книгу
 Excel.WorkBooks.Add;
 // в переменную "загоняем" текущий лист
 Sheets := Excel.Workbooks[1].Sheets[1];
 except
 SysUtils.Beep;
 ShowMessage('Не могу открыть Excel!');
 Exit;
 end;
 // рисуем border
 // сначала определяем диапазон
 Range := Sheets.Range['B1'];
 Range.Borders[4].LineStyle := 1; // Range.Borders[4] - можно ставить от 1 до 8 - точно не помню
 // рисуем border вокруг ячейки (обрамление)
 Range.Borders[1].LineStyle := 1;
 Range.Borders[2].LineStyle := 1;
 Range.Borders[3].LineStyle := 1;
 Range.Borders[4].LineStyle := 1;
 // присваиваем значение ячейке
 Sheets.Cells[2, 2] := Edit1.Text; // формат Sheets.Cells[№ строки, № колонки]
 // так выполняем выравнивание в диапазоне
 // присваиваем диапазону координаты ячейки
 Range := Sheets.Cells[2, 2]; // можно переменные Range := Sheets.Cells[iRow, iCol];
 Range.HorizontalAlignment := xlCenter;
 Range.VerticalAlignment := xlCenter;
 // форматируем шрифт
 Sheets.Cells[iRow, 3] := 'ЗАЯВКА';
 Range := Sheets.Cells[iRow, 3];
 Range.Font.Bold := True;
 // с присваиванием значения ячейке могут быть проблемы, т.к. Excel думает, что он очень умный
 // и вместо числа может переформатировать в дату вида 12дек2004, что бы такого не случилось,
 // можно заранее отформатировать ячейку в нужный формат (дата, число, валюта, текстовый)
 // все форматы можно узнать в Excel`е, с пом. макросов, просмотрев затем код, созданный самим
 // Excel`ем
 // #,##0.000$ - денежный
 // [$-FC19]dd mmmm yyyy г/;@ - дата
 // h:mm;@ - время
 // 0.00% - проценты
 // # ??/?? - простые дроби 21/25
 // [<=9999999]###-####;(###) ###-#### - номер телефона
 // @ - текстовый формат, если указывать такой формат и присваивать
 // числовое значение, а затем складывать, то ничего не выйдет
 // передаваемая строки из Delphi может отличаться, нужно экспериментировать
 // tZay: TTable
 // dbGridZay: DBGrid
 // vRow: Integer
 while not tZay.Eof do
 begin
 for iColCount := 0 to dbGridZay.Columns.Count-1 do
 begin
 Range := Sheets.Cells[vRow, iColCount+1];
 case tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).DataType of
 ftFloat:
 begin
 Range.NumberFormat := '0,000';
 Sheets.Cells[vRow, iColCount+1] := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsFloat
 end;
 ftString:
 begin
 Range.NumberFormat := '@';
 Sheets.Cells[vRow, iColCount+1] := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsString;
 end;
 
 ftInteger:
 begin
 Range.NumberFormat := '0';
 Sheets.Cells[vRow, iColCount+1] := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsInteger;
 end;
 
 ftAutoinc:
 begin
 Range.NumberFormat := '0';
 Sheets.Cells[vRow, iColCount+1] := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsInteger;
 end;
 ftDate:
 begin
 Range.NumberFormat := '@';
 dDate := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsDateTime;
 Sheets.Cells[vRow, iColCount+1] := FormatDateTime('dd.mm.yyyy', dDate);
 end;
 else
 Range.NumberFormat := '@';
 Sheets.Cells[vRow, iColCount+1] := tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsString;
 end; // case
ID: 04395
----
== Удаляем лишние столбцы (по умолчанию со сдвигом влево) ==
 // dbGridZay: DBGrid
 for iColCount := dbGridZay.Columns.Count-1 downto 0 do
 begin
 if dbGridZay.Columns[iColCount].Visible = False then
 begin
 UsedRange := Sheets.Range['A1', 'Z100']; // диапазон поиска заголовка
 Range := UsedRange.Find(What := dbGridZay.Columns[iColCount].title.Caption, LookIn := xlValues, LookAt := xlWhole, SearchDirection := xlNext);
 if not VarIsEmpty(Range) then
 begin
 try
 FirstAddress := Range.Address;
 s := StringReplace(FirstAddress, '$', , [rfReplaceAll]);
 Range := Sheets.Range[s + ':' + Copy(s, 1, 1) + IntToStr(vRow)];
 Range.Delete;
 except
 end;
 end;
 end;
 end;
 // Объединение ячеек
 Sheet.Range[...].Merge(Across);
ID: 04396
----
== Относительно LOCALE_USER_DEFAULT ==
Теоретически, в MSDN написано: "Indicates that the parameter is a locale ID (LCID)". Одни (Чарльз Калверт) предлагают в качестве его использовать 0, как идентификатор языка по умолчанию, другие - результат функции GetUserDefaultLCID. В некоторых случаях, чаще в связке Windows 2000 + Excel 2000, оба решения не проходят. Причем, выдается сообщение о попытке "использовать библиотеку старого формата..." Поэтому, рекомендуем в качестве lcid использовать значение константы LOCALE_USER_DEFAULT.
== Относительно открытия существующих рабочих книг ==
Вот как описан метод Open в импортированной библиотеке типов:
function Open(const Filename: WideString; UpdateLinks: OleVariant; ReadOnly: OleVariant;
 Format: OleVariant; Password: OleVariant; WriteResPassword: OleVariant;
 IgnoreReadOnlyRecommended: OleVariant; Origin: OleVariant;
 Delimiter: OleVariant; Editable: OleVariant; Notify: OleVariant;
 Converter: OleVariant; AddToMru: OleVariant; lcid: Integer): Workbook; safecall;
Что вам из всего этого может понадобиться:
* FileName - Имя открываемого файла, желательно с полным путем, иначе Excel будет искать этот файл в каталоге по умолчанию;
* AddToMru := True - если необходимо запомнить файл в списке последних открытых файлов;
* IgnoreReadOnlyRecommended - Если файл рекомендован только для чтения, то при открытии Excel выдает соответствующее предупреждение. Чтобы его игнорировать, передайте в качестве данного параметра True.
Используя позднее связывание
При позднем связывании не нужно указывать все дополнительные параметры или LCID, можно просто написать вот так:
var
 Workbook: OLEVariant;
begin
 Workbook := Excel.WorkBooks.Open('C:\Test.xls');
end;
; Примечание: Если вы хотите получше узнать метод Open, например, как с его помощью открывать файлы текстовых форматов с разделителями, воспользуйтесь "пишущим" плеером VBA. Запишите макросы, а затем поправьте их по необходимости.
== Создание новой книги ==
Используя раннее связывание
var
 IWorkbook: Excel8_TLB._Workbook;
begin
 IWorkbook := IExcel.Workbooks.Add(EmptyParam, xlLCID);
end;
Передача в качестве первого параметра EmptyParam означает, что будет создана новая книга с количеством пустых листов, выставленным по умолчанию. Если в первом параметре вы передадите имя файла (с полным путем, иначе поиск осуществляется в каталоге по умолчанию), этот файл будет использован как шаблон для новой книги. Вы можете также передать одну из следующих констант: xlWBATChart, xlWBATExcel4IntlMacroSheet, xlWBATExcel4MacroSheet, или xlWBATWorksheet. В результате будет создана новая книга с единственным листом указанного типа.
; Внимание - важно!
: Excel не может держать открытыми несколько книг с одинаковыми названиями, даже если они лежат в разных каталогах, поэтому при создании файла по шаблону добавляет к имени файла новой книги номер (шаблон "test.xls" - новый файл "test1.xls").
== Закрытие книги ==
Используя раннее связывание
var
 SaveChanges: Boolean;
begin
 SaveChanges := True;
 IWorkbook.Close(SaveChanges, EmptyParam, EmptyParam, xlLCID);
Если в качестве параметра SaveChanges вы передадите EmptyParam, Excel задаст вопрос, сохранять ли рабочую книгу. Второй параметр позволяет вам определить имя файла, а третий указывает, нужно ли отправлять книгу следующему получателю.
Используя позднее связывание
При позднем связывании нет необходимости указывать дополнительные параметры, поэтому вы можете просто написать:
Workbook.Close(SaveChanges := True);
или
Workbook.Close;
== Как передать абсолютный адрес ячейки? ==
Нужно использовать символ $
 Лист1!$A$1:$D$3'
== Добавление модулей и процедур ==
Так можно добавить новый модуль:
var
 IModule: VBIDE8_TLB.VBComponent; // с эти нужно поэкспериментировать
begin
 IModule := IWorkbook.VBProject.VBComponents.Add( TOLEEnum(VBIDE8_TLB.vbext_ct_StdModule) );
 IModule.Name := 'MyModule1';
поместить в него новую процедуру VBA:
IModule.CodeModule.AddFromString('PUBLIC SUB MySub1()'#13'Msgbox "Hello, World!"'#13'End sub'#13);
и запустить эту процедуру
OLEVariant(Excel).Run('MyModule1.MySub1');
== Различные способы обращения к ячейкам ==
var
 Value: Variant;
begin
 try
 // различные способы
 Value := ISheet.Cells.Item[2, 1].Value;
 Value := ISheet.Range['A2', EmptyParam].Value;
 Value := ISheet.Range['TestCell', EmptyParam].Value;
 Value := IWorkbook.Names.Item('TestCell', EmptyParam, EmptyParam).RefersToRange.Value;
 finally
 ISheet := nil;
 end;
end;
ID: 04397
== Копирование данных в буфер обмена ==
var
 ISheetSrc, ISheetDst: Worksheet; // в разных версиях
 IRangeSrc, IRangeDst: Range; // могут объявляться по разному
begin
 IRangeSrc.Copy(IRangeDst);
Метод Copy интерфейса Range принимает в качестве параметра любой другой Range, совпадение размеров источника и получателя необязательно.
При копировании области убедитесь, что не редактируете ячейку, иначе возникнет исключение "Call was rejected by callee".
Использование метода Copy без указания параметра destination скопирует ячейки в буфер обмена.
Author: Akella
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04398
Category:COM
Category:MS Office