Получить цвет ячейки EXCEL на Delphi.

[as091isk]

Всем, доброго дня.

Уважаемые эксперты, помогите найти решение проблемы.

У меня есть лист EXCEL с данными, размером 50 строк х 250 столбцов.
Каждая ячейка помимо текста закрашена в один из 4 цветов - зеленый, красный, желтый, коричневый.

Подключаюсь к EXCEL через COM, естественно в потоке.
Данные с листа считываю через объект Range:

Result:=MyExcel.WorkSheets[WorksheetIndex].Range[R].Value;

Проблема в том, что Result содержит только текст. Мне нужен именно цвет каждой ячейки.

При прямом чтении цвета каждой ячейки получаю катастрофически низкую производительность приложения:

RangeColor:=MyExcel.WorkSheets[WorksheetIndex].Range[R];
for row:= 1 to 50 do begin
for col := 1 to 250 do begin
Color:=RangeColor.cells[row,col+5+c+1].Interior.Color;
......
.......
......
end;
end;

Что же делать, как же быть?

[kropotkina-alice]

Готовый ответ не дам, заставлю малость применить собственный мозг.
Вот вам пример для цвета шрифта:

Workbooks[1].WorkSheets[2].Range['B34'].Font.Color:=clRed

[as091isk]

Попробовал ваш метод. Результаты неутешительные.

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Variants, System.StrUtils , System.Classes,System.UITypes,
  ComObj, ActiveX;


const EXCELAPP='Excel.Application';

var     MyExcel : OleVariant;

// функция проверяет, установлен ли EXCEL
function CheckExcelInstall:boolean;
var
 ClassID:TCLSID;
 Rez:HRESULT;
begin
 // ищем CLSID OLE - объекта
 Rez:=CLSIDFromProgID(PWideChar(WideString(EXCELAPP)), ClassID);
 if Rez = S_OK then Result:=true
               else Result:=false;
end;


function RunExcel(DisableAlerts:boolean=true; Visible: boolean=false): boolean;
begin
  try
{проверяем установлен ли Excel}
    if CheckExcelInstall then
      begin
        MyExcel:=CreateOleObject(ExcelApp);
//показывать/не показывать системные сообщения Excel (лучше не показывать)
        MyExcel.Application.EnableEvents:=DisableAlerts;
        MyExcel.Visible:=Visible;
        Result:=true;
      end
    else
      begin
        //MessageBox(0,'Приложение MS Excel не установлено на этом компьютере','Ошибка',MB_OK+MB_ICONERROR);
        Writeln('Приложение MS Excel не установлено на этом компьютере');
        Result:=false;
      end;
  except
    Result:=false;
  end;
end;

function OpenExcel(FileName:string):boolean;
begin
  try
    MyExcel.WorkBooks.Open(FileName);
    Result:=True;
  except
    Result:=false;
  end;
end;

function ExitExcel:boolean;
begin
  try
    if MyExcel.Visible then MyExcel.Visible:=false;
    MyExcel.Quit;
    MyExcel:=Unassigned;
    Result:=True;
  except
    Result:=false;
  end;
end;

// прочитать диапазон или ячейку  (строка)  i=0 --> кол-во листов
function WSRangeRead(WorksheetIndex:integer; R:string):Variant;//string;
begin
 try
   if WorksheetIndex=0 then WorksheetIndex:=MyExcel.WorkSheets.count;
   MyExcel.Worksheets[WorksheetIndex].Activate;
   //Result:=MyExcel.WorkSheets[WorksheetIndex].Range[R];//.ColorIndex;
   Result:=MyExcel.WorkSheets[WorksheetIndex].Range[R].Interior.Color;
  except
    Result:='Read error';
  end;
end;

//Из номера колонки и строки получаем ее буквенное значение
//Например Cells(2,2) будет равен Range(B2)
function GetAddressCells(num_col,num_row:integer):string;
var str_tmp:string;
begin
  str_tmp:='';
  str_tmp:=MyExcel.WorkSheets[1].Cells[num_col,num_row].address;
  Result:=StringReplace(str_tmp,'$','',[rfReplaceAll,rfIgnoreCase]);
end;

//-----------------------------------------------------------------------------\\
Procedure Dowork;

var f:textfile;

    ExcelFile  : string;
    RangeColor : Variant;

    row        : byte;
    col        : byte;

    Color      : TColor;
begin
  assignfile(f,'log.txt');
  append(f);
  Writeln(f,FormatDateTime('YYYY-MM-DD hh:mm:ss:zzz',noW));
  Closefile(f);

  CoInitializeEx(nil, COINIT_MULTITHREADED); //так правильнее, должно быстрее работать
  RunExcel;
  OpenExcel('C:\Users\Малой\Desktop\Новая папка2\Win32\Debug\Данные с датчиков Февраль.xlsx');

  for row := 1 to 35  do begin
  for col := 1 to 250 do begin
  Color:=MyExcel.Workbooks[1].WorkSheets[1].Range[GetAddressCells(row,col)].Interior.Color;
                         end;
                         end;
  ExitExcel;
  CoUninitialize;

  assignfile(f,'log.txt');
  append(f);
  Writeln(f,FormatDateTime('YYYY-MM-DD hh:mm:ss:zzz',noW));
  Closefile(f);
end;


begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    Dowork;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

Время выполнения составило полторы минуты. Очень очень много.
Содержимое log.txt:

2015-04-12 17:47:46:504
2015-04-12 17:49:03:879



Дабы не быть голословным в приложении мое решение. (форум не позволяет более 5000 символов в сообщении).
Время выполнения составило около 40 секунд, что тоже очень много.
Содержимое log.txt:

2015-04-12 17:18:40:916
2015-04-12 17:19:26:992


Как мне кажется проблема в последовательном доступе к каждой ячейки.

[xxbesoxx]

Я бы приступил так . при нажатие кнопки импортировал это файл к БД хотя бы Access и потом начал закрашивать эту в Grid-е ячейки по условие и все ... выложите ваши файл Excel-а и скажите условие по каком он там должен закрашенный

kropotkina-alice красива дівчина христос воскрес

[Аватар]

импортировал это файл к БД хотя бы Access и потом начал закрашивать эту в Grid-е ячейки по условие и все ...

И что, как узнать цвет ячеек?

Можно выгрузить как xml-книгу. И пропарсить его. Там в стилях есть цвета заливки и фона, а для каждой ячейки ссылка на стиль. Немного нудно, но зато быстро

[xxbesoxx]

И что, как узнать цвет ячеек?

Друг, Я так думаю что он там закрашены по какой то условие и не для красоты... и можно писать то условия

[Stilet]

for row := 1 to 35 do begin
for col := 1 to 250 do begin
Color:=MyExcel.Workbooks[1].WorkSheets[1].Range[GetAddressCells(row,col)].Interior.Color;
end;
end;

Во-первых:

var sht:OleVariant;
...
 with MyExcel.Workbooks[1].WorkSheets[1].Range[GetAddressCells(1,1),GetAddressCells(35,250)] do
  for row := 1 to 35  do begin
   for col := 1 to 250 do begin
    Color:=Cells[row,col].Interior.Color;
   end;
  end;

Это чуть ускорит работу, однако сразу возникает вопрос, а точнее два:
1) Куда смотрит оптимизатор?
2) Зачем нужно получать цвет, и где потом это используется?

CoInitializeEx(nil, COINIT_MULTITHREADED); //так правильнее, должно быстрее работать

Это из разряда мифов.

[Аватар]

и можно писать то условия

Про условия у ТС нужно спросить. А вдруг какой-то тайный смысл у цвета А с xml очень быстро, цвета ячеек не узнавал, но документы в виде xml-таблицы на несколько сотен строк и порядочное количество колонок мигом формируются, и экселя установленного не надо. То же, но через OLE очень долго

[xxbesoxx]

А вдруг какой-то тайный смысл у цвета

Да , да я так думаю

[as091isk]

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

Во-первых:

var sht:OleVariant;
...
 with MyExcel.Workbooks[1].WorkSheets[1].Range[GetAddressCells(1,1),GetAddressCells(35,250)] do
  for row := 1 to 35  do begin
   for col := 1 to 250 do begin
    Color:=Cells[row,col].Interior.Color;
   end;
  end;

Это чуть ускорит работу, однако сразу возникает вопрос, а точнее два:
1) Куда смотрит оптимизатор?
2) Зачем нужно получать цвет, и где потом это используется?

Это из разряда мифов.

Да, действительно через

 Color:=Cells[row,col].Interior.Color;

работает чуточку быстрее. (делаю так в приложенном проекте).

Это чуть ускорит работу, однако сразу возникает вопрос, а точнее два:
1) Куда смотрит оптимизатор?
2) Зачем нужно получать цвет, и где потом это используется?

1) на увеличение скорости работы приложения. Если смотрю не туда, так ткни пальцем куда смотреть.
2) Нужно подсчитать количество переходов из зеленого цвета в желтый