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

Материал из DRKB


Пример импорта прайс-листа =[править | править код]

в секции 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