Перенести фон Stringgrid'a в таблицу excel

@spectr108 · Регистрация: 21.03.2012

Author24 — интернет-сервис помощи студентам

Добрый день.
В моей программке есть возможность выделять строки другим цветом, и уже 2 дня голову ломаю как скопировать фон стринггрида в ексель,т.е. например есть табличка с данными, допустим 5 строк, я выделил 2 и 4 строку, затем переношу в эксель, и в экселе так же должны быть выделены 2 и 4 строка тем же цветом.
И вообще возможно ли это)
внизу приложил скриншот как это выглядит в программе например

@Mawrat · 29.05.2013, 21:27

Передать таблицу на лист MS Excel можно так:

Delphi

uses
  ComObj;
 
{Передача данных из таблицы типа TStringGrid на лист рабочей книги MS Excel.
Передаются все строки - включая фиксированные, т. е., включая шапку и
заголовочные столбцы.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.
Функция возвращает ссылку на диапазон, в который записаны данные.}
function SgToExcel(aSg : TStringGrid; aExSh : Variant; const aRow, aCol : Integer) : Variant;
const
  SelfName = 'SgToExcel()';
var
  exCell, exRng : Variant;
  vArr : Variant;
  i, j : Integer;
begin
  VarClear(Result);
  //Создаём вариантный массив с размером, соответствующим размеру таблицы.
  vArr := VarArrayCreate([1, aSg.RowCount, 1, aSg.ColCount], varOleStr);
  //Записываем в вариантный массив данные таблицы.
  for i := 1 to aSg.RowCount do
  for j := 1 to aSg.ColCount do
    vArr[i, j] := aSg.Cells[j - 1, i - 1];
  //На листе MS Excel формируем диапазон, в который будут записаны данные.
  exCell := aExSh.Cells[aRow, aCol];
  exRng := aExSh.Range[exCell,
    exCell.Offset[aSg.RowCount - 1, aSg.ColCount - 1]];
  //Записываем данные вариантного массива в диапазон.
  exRng.Value := vArr;
 
  //Диапазон, в который записаны данные.
  Result := exRng;
end;

Эта функция, SgToExcel(), записывает данные таблицы типа TStringGrid на лист MS Excel. И возвращает ссылку на интерфейс диапазона ячеек, в котором расположена таблица.
Дальше остаётся раскрасить ячейки диапазона. Это можно сделать таким образом:

Delphi

uses
  ComObj;
 
//Запись данных таблицы на лист MS Excel и оформление диапазона.
procedure TForm1.Button1Click(Sender: TObject);
const
  //Толщина линий.
  xlThin = 2;
  xlMedium = -4138;
  //Вид линии.
  xlContinuous = 1; //Непрерывная линия.
var
  exApp, exBook, exSh, exRng, exRngTmp : Variant;
  i : Integer;
  Sg : TStringGrid;
  Sd : TSaveDialog;
begin
  Sg := StringGrid1;
  Sd := SaveDialog1; //SaveDialog1 уже должен быть на форме.
  if Sd.InitialDir = '' then
    Sd.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Sd.Execute then Exit;
  if FileExists(Sd.FileName) then begin
    i := MessageBox(0, 'Файл с заданным именем уже существует. Перезаписать?'
      ,'Перезаписать?', MB_YESNO + MB_ICONQUESTION + MB_APPLMODAL);
    if i = IDNO then Exit;
  end;
 
  //Попытка подключиться к корневому объекту MS Excel.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
      'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
    Exit;
  end;
 
  //Делаем видимым окно MS Excel.
  exApp.Visible := True;
  //Создаём рабочую книгу.
  exBook := exApp.WorkBooks.Add;
  //Получаем ссылку на первый лист рабочей книги.
  exSh := exBook.Worksheets[1];
  //Для ускорения работы с MS Excel отключаем режим перерисовки окон MS Excel.
  exApp.ScreenUpdating := False;
  try
    //Передаём данные из таблицы на лист MS Excel. Функция возвращает ссылку
    //на интерфейс диапазона, в который записались данные таблицы.
    exRng := SgToExcel(Sg, exSh, cRow1, cCol1);
 
    //Оформление диапазона таблицы.
 
    //Шапка.
 
    //Собираем диапазон шапки.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedRows do
      if i = 1 then
        exRngTmp := exRng.Rows[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRng.Rows[i]);
    //Оформление диапазона шапки.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.ColorIndex := 15;
    end;
 
    //Заголовочные столбцы.
 
    //Собираем диапазон заголовочных столбцов.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedCols do
      if i = 1 then
        exRngTmp := exRng.Columns[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRngTmp.Columns[i]);
    //Оформление диапазона заголовочных столбцов.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.ColorIndex := 15;
    end;
 
    //Строки данных.
 
    exRngTmp := exRng;
    //Исключаем из диапазона шапку.
    exRngTmp := exApp.Intersect(exRngTmp, exRngTmp.Offset[Sg.FixedRows, 0]);
    //Исключаем из диапазона заголовочные столбцы.
    exRngTmp := exApp.Intersect(exRngTmp, exRngTmp.Offset[0, Sg.FixedCols]);
    //Обрамление ячеек.
    exRngTmp.Borders.LineStyle := xlContinuous;
    exRngTmp.Borders.Weight := xlThin;
    //Цвет фона.
    //Цвета задаём с чередованием - белый/ораньжевый.
    for i := 1 to Sg.RowCount - Sg.FixedRows do
      if i mod 2 = 0 then //Для чётных строк фон - ораньжевый.
        exRngTmp.Rows[i].Interior.ColorIndex := 45;
 
    //Вся таблица.
 
    //Подбор ширины столбцов по содержимому.
    exRng.Columns.AutoFit;
  finally
    //Включаем режим перерисовки окон MS Excel.
    exApp.ScreenUpdating := True;
  end;
 
  //Сохраняем рабочую книгу.
  //Отключаем режим предупреждений. - Чтобы не выводился диалог о перезаписи
  //файла, если он уже существует.
  exApp.DisplayAlerts := False;
  try
    exBook.SaveAs(FileName:=Sd.FileName);
  finally
    //Включаем режим предупреждений.
    exApp.DisplayAlerts := True;
  end;
 
  //Закрытие рабочей книги MS Excel.
  //exBook.Close;
  //Выход из MS Excel.
  //exApp.Quit;
end;

В этом коде фон шапки таблицы и заголовочных столбцов закрашивается серым цветом, а цвет фона для строк данных чередуется: нечётные строки - белый фон, чётные - оранжевый (светло-коричневый) фон.

@spectr108 · 30.05.2013, 08:17 **[ТС]**

Канешно спасибо, но это не много не то что я просил, вы просто раскрасили ячейки четные не четные, а я просил чтобы именно фон копировался, как я сказал у меня в программе можно строки выделять, т.е. фон у меня белый, я тыкаю на ctrl+лкм по строке, и она красная становится... я могу так и все таблицу красной сделать, и вот можно чтобы именно фон копировался?)

Добавлено через 2 часа 17 минут
Что то я стал сомневаться в том возможно ли это))
придумал другой вариант, добавил строчку кода , теперь когда я тыкаю лкм+ctrl по строчке, она также красится в красный и + в отдельной ячейке на этой строке добавляется символ "$".
И вот от сюда следует новый вопрос. Как сделать чтобы когда все это переносится в эксель, в экселе искался этот символ $ и если найден то строка в экселе красилась бы в красный цвет?
это звучит более реальнее и проще чем я спрашивал выше)))

@Mawrat · 30.05.2013, 10:36

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

а я просил чтобы именно фон копировался, как я сказал у меня в программе можно строки выделять, т.е. фон у меня белый, я тыкаю на ctrl+лкм по строке, и она красная становится.

Понятно, можно и фон копировать. Я вечером сегодня напишу как это можно сделать.

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

придумал другой вариант, добавил строчку кода , теперь когда я тыкаю лкм+ctrl по строчке, она также красится в красный и + в отдельной ячейке на этой строке добавляется символ "$".
И вот от сюда следует новый вопрос. Как сделать чтобы когда все это переносится в эксель, в экселе искался этот символ $ и если найден то строка в экселе красилась бы в красный цвет?

Здесь немного по-другому надо действовать. В общем, вечером сегодня напишу.

Добавлено через 12 минут
spectr108, пока посмотри вот эти посты:
1. Меняем цвет ячеек стрингрида. - По левой кнопке мыши ячейка закрашивается, по правой - цвет в ячейке сбрасывается.
2. Раскраска ячеек в stringgrid. - Пометить цветом те ячейки, которые подверглись редактированию.
3. Раскраска StringGrid.

@spectr108 · 30.05.2013, 10:48 **[ТС]**

Да спасибо за ссылки) правда я их уже видел. и я сделал так как в первой сылке что ты дал, только я добавил чтобы нужно было ctrl нажимать ещё ))) жду вечером

@Mawrat · 30.05.2013, 17:02

Вот что получилось. Здесь к ячейкам таблицы TStringGrid прикрепляются прямо сами RGB коды цветов. И при переносе таблицы на лист MS Excel, цвет (RGB код) фона ячейки Excel устанавливается равным RGB коду, прикреплённому к соответствующей ячейке таблицы TStringGrid.

Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StringGrid1: TStringGrid;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  ComObj;
 
const
  //Координаты верхней левой ячейки таблицы на листе MS Excel.
  cRow1 = 3;
  cCol1 = 2;
 
//Очистка таблицы типа TStringGrid и сброс её размеров.
procedure SgClear(aSg : TStringGrid);
var
  Row : Integer;
begin
  //Можно было бы чистить по столбцам - их чаще всего меньше, чем строк,
  //но тогда мы стёрли бы надписи в шапке таблицы.
  for Row := aSg.FixedRows to aSg.RowCount - 1 do
    aSg.Rows[Row].Clear;
  aSg.RowCount := aSg.FixedRows + 1;
end;
 
{Передача данных из таблицы типа TStringGrid на лист рабочей книги MS Excel.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.
Функция возвращает ссылку на диапазон, в который записаны данные.}
function SgToExcel(aSg : TStringGrid; aExSh : Variant; const aRow, aCol : Integer) : Variant;
const
  SelfName = 'SgToExcel()';
var
  exCell, exRng : Variant;
  vArr : Variant;
  i, j : Integer;
begin
  VarClear(Result);
 
  //Создаём вариантный массив с размером, соответствующим размеру таблицы.
  vArr := VarArrayCreate([1, aSg.RowCount, 1, aSg.ColCount], varOleStr);
  //Записываем в вариантный массив данные таблицы.
  for i := 1 to aSg.RowCount do
  for j := 1 to aSg.ColCount do
    vArr[i, j] := aSg.Cells[j - 1, i - 1];
  //На листе MS Excel формируем диапазон, в который будут записаны данные.
  exCell := aExSh.Cells[aRow, aCol];
  exRng := aExSh.Range[exCell,
    exCell.Offset[aSg.RowCount - 1, aSg.ColCount - 1]];
  //Записываем данные вариантного массива в диапазон.
  exRng.Value := vArr;
 
  //Диапазон, в который записаны данные.
  Result := exRng;
end;
 
//Обработчик, который вызывается при щелчке мышью в области таблицы.
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Sg : TStringGrid;
  Col, Row : Integer;
begin
  Sg := Sender as TStringGrid;
  //Определяем координаты ячейки, на которой произошёл щелчок мыши.
  Sg.MouseToCell(X, Y, Col, Row);
  //Если ячейка расположена в области фиксированных ячеек, то выходим.
  if (Row < Sg.FixedRows) or (Col < Sg.FixedCols) then Exit;
  //Если произошёл щелчок левой кнопкой мыши - устанавливаем цвет.
  if Button = mbLeft then begin
    {Под видом указателя на объект, который связан с ячейкой, записываем
    RGB код цвета. Значение, отличное от 0 (нуля), означает, что цвет ячейки
    изменён и под видом указателя записан его RGB код.}
    Sg.Rows[Row].Objects[Col] := TObject(RGB($DF, $87, 0));
  {Если произошёл щелчок правой кнопкой мыши - обнуляем RGB код цвета.
  Здесь следует отменить, что значению = 0 соответствует чёрный цвет, а
  мы задействовали значение 0, как знак того, что цвет не установлен.
  По этой причине нельзя задавать код абсолютного чёрного цвета. Вместо
  него можно задать, например такой: RGB(1, 0, 0).}
  end else if Button = mbRight then begin
    Sg.Rows[Row].Objects[Col] := TObject(0);
  end;
end;
 
//Обработчик, который вызывается при перерисовке ячейки.
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Sg : TStringGrid;
  CellColor : TColor;
begin
  Sg := Sender as TStringGrid;
  //Если ячейка расположена в области фиксированных ячеек, то выходим.
  if (ARow < Sg.FixedRows) or (ACol < Sg.FixedCols) then Exit;
  //Читаем RGB код цвета, который записан под видом указателя на объект.
  CellColor := TColor(Sg.Rows[ARow].Objects[ACol]);
  //Если RGB код равен 0 - выходим.
  if CellColor = 0 then Exit;
  //В противном случае, изменяем цвет ячейки.
  with Sg.Canvas do begin
    //Цвет кисти.
    Brush.Color := CellColor;
    //Заливаем квадрат ячейки цветом кисти.
    FillRect(Rect);
    //Прорисовываем в ячейке текст. Здесь +3 и +2 - так мы задаём ширину
    //полей в ячейке.
    TextOut(Rect.Left + 3, Rect.Top + 2, Sg.Cells[ACol, ARow]);
  end;
end;
 
//Оформление шапки таблицы.
procedure TForm1.FormCreate(Sender: TObject);
var
  Col : Integer;
  Sg : TStringGrid;
begin
  Sg := StringGrid1;
  //Шапка таблицы.
  for Col := 0 to Sg.ColCount - 1 do
    Sg.Cells[Col, 0] := 'TitleCol-' + FormatFloat('00', Col);
end;
 
//Запись данных на лист MS Excel.
procedure TForm1.Button1Click(Sender: TObject);
const
  //Толщина линий.
  xlThin = 2;
  xlMedium = -4138;
  //Вид линии.
  xlContinuous = 1; //Непрерывная линия.
var
  exApp, exBook, exSh, exRng, exRngTmp : Variant;
  i, j : Integer;
  CellColor : TColor;
  Sg : TStringGrid;
  Sd : TSaveDialog;
begin
  Sg := StringGrid1;
  Sd := SaveDialog1; //SaveDialog1 уже должен быть на форме.
  if Sd.InitialDir = '' then
    Sd.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Sd.Execute then Exit;
  if FileExists(Sd.FileName) then begin
    i := MessageBox(0, 'Файл с заданным именем уже существует. Перезаписать?'
      ,'Перезаписать?', MB_YESNO + MB_ICONQUESTION + MB_APPLMODAL);
    if i = IDNO then Exit;
  end;
 
  //Попытка подключиться к корневому объекту MS Excel.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
      'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
    Exit;
  end;
 
  //Делаем видимым окно MS Excel.
  exApp.Visible := True;
  //Создаём рабочую книгу.
  exBook := exApp.WorkBooks.Add;
  //Получаем ссылку на первый лист рабочей книги.
  exSh := exBook.Worksheets[1];
  //Для ускорения работы с MS Excel отключаем режим перерисовки окон MS Excel.
  exApp.ScreenUpdating := False;
  try
    //Передаём данные из таблицы на лист MS Excel. Функция возвращает ссылку
    //на интерфейс диапазона, в который записались данные таблицы.
    exRng := SgToExcel(Sg, exSh, cRow1, cCol1);
 
    exRng.Borders.LineStyle := xlContinuous;
    exRng.Borders.Weight := xlThin;
    //Шапка.
 
    //Составляем диапазон шапки.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedRows do
      if i = 1 then
        exRngTmp := exRng.Rows[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRng.Rows[i]);
    //Оформление диапазона шапки.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.Color := RGB($CC, $CC, $CC); //Серый.
    end;
 
    //Заголовочные столбцы.
 
    //Собираем диапазон заголовочных столбцов.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedCols do
      if i = 1 then
        exRngTmp := exRng.Columns[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRng.Columns[i]);
    //Оформление диапазона заголовочных столбцов.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.Color := RGB($CC, $CC, $CC); //Серый.
    end;
 
    //Строки данных.
 
    for i := Sg.FixedRows to Sg.RowCount - 1 do
    for j := Sg.FixedCols to Sg.ColCount - 1 do begin
      CellColor := TColor(Sg.Rows[i].Objects[j]);
      if CellColor > 0 then
        exRng.Cells[i + 1, j + 1].Interior.Color := CellColor;
    end;
 
    //Вся таблица.
 
    //Подбор ширины столбцов по содержимому.
    exRng.Columns.AutoFit;
  finally
    //Включаем режим перерисовки окон MS Excel.
    exApp.ScreenUpdating := True;
  end;
 
  //Сохраняем рабочую книгу.
  //Отключаем режим предупреждений. - Чтобы не выводился диалог о перезаписи
  //файла, если он уже существует.
  exApp.DisplayAlerts := False;
  try
    exBook.SaveAs(FileName:=Sd.FileName);
  finally
    //Включаем режим предупреждений.
    exApp.DisplayAlerts := True;
  end;
 
  //Закрытие рабочей книги MS Excel.
  //exBook.Close;
  //Выход из MS Excel.
  //exApp.Quit;
end;
 
//Заполнение таблицы данными.
procedure TForm1.Button2Click(Sender: TObject);
var
  i, Row, Col : Integer;
  Sg : TStringGrid;
begin
  Sg := StringGrid1;
  Randomize;
  SgClear(Sg);
  Sg.RowCount := Sg.FixedRows + Random(100);
  i := 0;
  for Row := Sg.FixedRows to Sg.RowCount - 1 do begin
    Inc(i); //Номер строки данных.
    Sg.Cells[0, Row] := FormatFloat('000', i);
    for Col := 0 + 1 to Sg.ColCount - 1 do
      Sg.Cells[Col, Row] := 'Data-' + FormatFloat('000', Random(1000));
  end;
end;
 
//Очистка таблицы.
procedure TForm1.Button3Click(Sender: TObject);
begin
  SgClear(StringGrid1);
end;
 
end.

@spectr108 · 30.05.2013, 17:49 **[ТС]**

Огромное при огромное спасибо

это все же оказалось реальным и самое смешное что мне пришлось изменить 2 моих строчки на ваши и добавить 4-5 ваших) вроде так немного а так много времени у меня отняло.
да и ещё 1 вопрос: сложно ли сделать чтобы из экселя тоже цвет передавался в stringgrid?

@Mawrat · 31.05.2013, 09:44

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

сложно ли сделать чтобы из экселя тоже цвет передавался в stringgrid?

Можно вот таким образом сделать. Данные из Excel забираем с помощью функции ExcelToSg(). Эта функция забирает данные из Excel и записывает их в экземпляр TStringGrid. Кроме этого, ExcelToSg() возвращает ссылку на интерфейс диапазона таблицы на листе Excel. Далее мы перебираем ячейки в диапазоне Excel, читаем их фоновые цвета (RGB коды) и прикрепляем их к ячейкам экземпляра TStringGrid.

Delphi

{Чтение данных с листа рабочей книги MS Excel в таблицу типа TStringGrid.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.}
function ExcelToSg(aExSh : Variant; const aRow, aCol : Integer; aSg : TStringGrid) : Variant;
const
  SelfName = 'ExcelToSg()';
  //Идентификатор типа ячейки в диапазоне - последняя (справа внизу) ячейка диапазона.
  xlCellTypeLastCell = 11;
var
  exRng, exCell1, exCell2 : Variant;
  vArr : Variant;
  i, j : Integer;
begin
  VarClear(Result);
  //Очистка StringGrid.
  SgClear(aSg);
  //Левая верхняя ячейка диапазона с данными.
  exCell1 := aExSh.Cells[aRow, aCol];
  //Правая нижняя ячейка используемого диапазона на листе.
  {Используемый диапазон - это прямоугольная область на листе MS Excel, которая
  охватывает все используемые ячейки. К используемым ячейкам относятся не только
  те ячейки, которые содержат данные, но и те, в которых изменено оформление или
  в которых записаны формулы.}
  exCell2 := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell);
  //Если диапазон, где должна быть таблица - пуст, то выходим.
  if (exCell2.Row < exCell1.Row) or (exCell2.Column < exCell1.Column) then
    Exit;
  //Определяем диапазон таблицы в соответствие с количеством столбцов в StringGrid.
  exRng := aExSh.Range[exCell1,
    exCell1.Offset[exCell2.Row - exCell1.Row, aSg.ColCount - 1]];
  //Получаем данные диапазона в виде вариантного массива.
  vArr := exRng.Value;
 
  //Задаём количество строк таблицы.
  if VarArrayHighBound(vArr, 1) < 2 then
    aSg.RowCount := 2
  else
    aSg.RowCount := VarArrayHighBound(vArr, 1);
  //Копирование данных массива в ячейки таблицы.
  for i := 1 to VarArrayHighBound(vArr, 1) do
  for j := 1 to VarArrayHighBound(vArr, 2) do
    aSg.Cells[j - 1, i - 1] := vArr[i, j];
 
  //Возвращаем ссылку на интервейс диапазона MS Excel, из которого взяты данные.
  Result := exRng;
end;
 
//Чтение данных с листа MS Excel.
procedure TForm1.Button1Click(Sender: TObject);
var
  exApp, exBook, exSh, exRng : Variant;
  i, j : Integer;
  CellColor : TColor;
  Sg : TStringGrid;
  Od : TOpenDialog;
begin
  Sg := StringGrid1;
  Od := OpenDialog1; //OpenDialog1 уже должен быть на форме.
  if Od.InitialDir = '' then
    Od.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Od.Execute then Exit;
  if not FileExists(Od.FileName) then begin
    MessageBox(0, 'Файл с заданным именем не найден. Действие отменено.'
      ,'Файл не найден', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
 
  //Попытка подключиться к корневому объекту MS Excel.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
      'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
    Exit;
  end;
  //Делаем видимым окно MS Excel. На время отладки или на постоянной основе.
  exApp.Visible := True;
  //Открываем файл рабочей книги.
  exBook := exApp.WorkBooks.Open(FileName:=Od.FileName);
  //Получаем ссылку на первый лист рабочей книги.
  exSh := exBook.Worksheets[1];
  //Получаем данные с листа рабочей книги MS Excel и записываем их
  //в нефиксированные строки таблицы.
  exRng := ExcelToSg(exSh, cRow1, cCol1, Sg);
 
  //Если данных нет, то выходим.
  if VarIsClear(exRng) then Exit;
 
  //Перенос цветов фона.
  for i := Sg.FixedRows to Sg.RowCount - 1 do
  for j := Sg.FixedCols to Sg.ColCount - 1 do begin
    //Получаем RGB код цвета фона в ячейке.
    CellColor := exRng.Cells[i + 1, j + 1].Interior.Color;
    {Если RGB код соответствует абсолютному чёрному цвету (=0), то
    заменяем этот код на ближайший по значению. Потому что у нас
    значение =0 задействовано, как признак того, что цвет не установлен.
    Если RGB код соответствует абсолютному белому цвету, то такой цвет
    можно оставить как есть. Или его можно сделать равным нулю, потому что
    при значении =0 оформление ячейки в нашем коде не выполняется.}
    if CellColor = 0 then
      CellColor := 1 //:= RGB(1, 0, 0);
    else if CellColor = $FFFFFF then
      CellColor := 0;
 
    //Прикрепляем к ячейке TStringGrid полученный RGB код под видом объекта.
    Sg.Rows[i].Objects[j] := TObject(CellColor);
  end;
end;

Здесь есть одна особенность при передаче цветов. Excel умеет отображать не все цвета палитры. Поэтому при передаче цвета в Excel, Excel его может немного изменить - привести к тому значению, которое она может отобразить. По этой причине, когда мы будем забирать цвета из Excel - они уже могут быть другими.
---
И ещё, при передаче данных в Excel, может быть полезной процедура удаления прежней таблицы:

Delphi

{Удаление таблицы на листе MS Excel.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.
aColCnt - количество столбцов в таблице MS Excel.}
procedure DelExcelTable(aExSh : Variant; const aRow, aCol, aColCnt : Integer);
const
  SelfName = 'DelExcelTable()';
  //Идентификатор типа ячейки в диапазоне - последняя (справа внизу) ячейка диапазона.
  xlCellTypeLastCell = 11;
  //Направление сдвига.
  xlShiftUp = -4162; //Вверх.
var
  exRng, exCell1, exCell2 : Variant;
begin
  //Левая верхняя ячейка диапазона с данными (т. е., исключая шапку из диапазона таблицы).
  exCell1 := aExSh.Cells[aRow, aCol];
  //Правая нижняя ячейка используемого диапазона на листе.
  {Используемый диапазон - это прямоугольная область на листе MS Excel, которая
  охватывает все используемые ячейки. К используемым ячейкам относятся не только
  те ячейки, которые содержат данные, но и те, в которых изменено оформление или
  в которых записаны формулы.}
  exCell2 := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell);
  //Если диапазон, где должны быть данные - пуст, то выходим.
  if (exCell2.Row < exCell1.Row) or (exCell2.Column < exCell1.Column) then
    Exit;
  //Определяем диапазон с данными в соответствие с заданным количеством столбцов.
  exRng := aExSh.Range[exCell1,
    exCell1.Offset[exCell2.Row - exCell1.Row, aColCnt - 1]];
  //Удаляем диапазон со сдвигом вверх.
  exRng.Delete(xlShiftUp);
end;

@spectr108 · 31.05.2013, 10:30 **[ТС]**

Спасибо большое, щас на работе, вечером дома буду попробую вставить в свой код

@Mawrat · 31.05.2013, 12:37

Архив с доработанным проектом.

Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    StringGrid1: TStringGrid;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  ComObj;
 
const
  //Координаты верхней левой ячейки таблицы на листе MS Excel.
  cRow1 = 3;
  cCol1 = 2;
 
//Очистка таблицы типа TStringGrid и сброс её размеров.
procedure SgClear(aSg : TStringGrid);
var
  Row, Col : Integer;
begin
  //Можно было бы чистить по столбцам - их чаще всего меньше, чем строк,
  //но тогда мы стёрли бы надписи в шапке таблицы.
  for Row := aSg.FixedRows to aSg.RowCount - 1 do
    aSg.Rows[Row].Clear;
  aSg.RowCount := aSg.FixedRows + 1;
  //Шапка таблицы.
  for Col := 0 to aSg.ColCount - 1 do
    aSg.Cells[Col, 0] := 'TitleCol-' + FormatFloat('00', Col);
end;
 
{Удаление таблицы на листе MS Excel.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.
aColCnt - количество столбцов в таблице MS Excel.}
procedure DelExcelTable(aExSh : Variant; const aRow, aCol, aColCnt : Integer);
const
  SelfName = 'DelExcelTable()';
  //Идентификатор типа ячейки в диапазоне - последняя (справа внизу) ячейка диапазона.
  xlCellTypeLastCell = 11;
  //Направление сдвига.
  xlShiftUp = -4162; //Вверх.
var
  exRng, exCell1, exCell2 : Variant;
begin
  //Левая верхняя ячейка диапазона с данными (т. е., исключая шапку из диапазона таблицы).
  exCell1 := aExSh.Cells[aRow, aCol];
  //Правая нижняя ячейка используемого диапазона на листе.
  {Используемый диапазон - это прямоугольная область на листе MS Excel, которая
  охватывает все используемые ячейки. К используемым ячейкам относятся не только
  те ячейки, которые содержат данные, но и те, в которых изменено оформление или
  в которых записаны формулы.}
  exCell2 := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell);
  //Если диапазон, где должны быть данные - пуст, то выходим.
  if (exCell2.Row < exCell1.Row) or (exCell2.Column < exCell1.Column) then
    Exit;
  //Определяем диапазон с данными в соответствие с заданным количеством столбцов.
  exRng := aExSh.Range[exCell1,
    exCell1.Offset[exCell2.Row - exCell1.Row, aColCnt - 1]];
  //Удаляем диапазон со сдвигом вверх.
  exRng.Delete(xlShiftUp);
end;
 
{Передача данных из таблицы типа TStringGrid на лист рабочей книги MS Excel.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.
Функция возвращает ссылку на диапазон, в который записаны данные.}
function SgToExcel(aSg : TStringGrid; aExSh : Variant; const aRow, aCol : Integer) : Variant;
const
  SelfName = 'SgToExcel()';
var
  exCell, exRng : Variant;
  vArr : Variant;
  i, j : Integer;
begin
  //Создаём вариантный массив с размером, соответствующим размеру таблицы.
  vArr := VarArrayCreate([1, aSg.RowCount, 1, aSg.ColCount], varOleStr);
  //Записываем в вариантный массив данные таблицы.
  for i := 1 to aSg.RowCount do
  for j := 1 to aSg.ColCount do
    vArr[i, j] := aSg.Cells[j - 1, i - 1];
  //На листе MS Excel формируем диапазон, в который будут записаны данные.
  exCell := aExSh.Cells[aRow, aCol];
  exRng := aExSh.Range[exCell,
    exCell.Offset[aSg.RowCount - 1, aSg.ColCount - 1]];
  //Записываем данные вариантного массива в диапазон.
  exRng.Value := vArr;
 
  //Диапазон, в который записаны данные.
  Result := exRng;
end;
 
{Чтение данных с листа рабочей книги MS Excel в таблицу типа TStringGrid.
aRow, aCol - координаты верхней левой ячейки таблицы на листе MS Excel.}
function ExcelToSg(aExSh : Variant; const aRow, aCol : Integer; aSg : TStringGrid) : Variant;
const
  SelfName = 'ExcelToSg()';
  //Идентификатор типа ячейки в диапазоне - последняя (справа внизу) ячейка диапазона.
  xlCellTypeLastCell = 11;
var
  exRng, exCell1, exCell2 : Variant;
  vArr : Variant;
  i, j : Integer;
begin
  VarClear(Result);
  //Очистка StringGrid.
  SgClear(aSg);
  //Левая верхняя ячейка диапазона с данными.
  exCell1 := aExSh.Cells[aRow, aCol];
  //Правая нижняя ячейка используемого диапазона на листе.
  {Используемый диапазон - это прямоугольная область на листе MS Excel, которая
  охватывает все используемые ячейки. К используемым ячейкам относятся не только
  те ячейки, которые содержат данные, но и те, в которых изменено оформление или
  в которых записаны формулы.}
  exCell2 := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell);
  //Если диапазон, где должна быть таблица - пуст, то выходим.
  if (exCell2.Row < exCell1.Row) or (exCell2.Column < exCell1.Column) then
    Exit;
  //Определяем диапазон таблицы в соответствие с количеством столбцов в StringGrid.
  exRng := aExSh.Range[exCell1,
    exCell1.Offset[exCell2.Row - exCell1.Row, aSg.ColCount - 1]];
  //Получаем данные диапазона в виде вариантного массива.
  vArr := exRng.Value;
 
  //Задаём количество строк таблицы.
  if VarArrayHighBound(vArr, 1) < 2 then
    aSg.RowCount := 2
  else
    aSg.RowCount := VarArrayHighBound(vArr, 1);
  //Копирование данных массива в ячейки таблицы.
  for i := 1 to VarArrayHighBound(vArr, 1) do
  for j := 1 to VarArrayHighBound(vArr, 2) do
    aSg.Cells[j - 1, i - 1] := vArr[i, j];
 
  //Возвращаем ссылку на интервейс диапазона MS Excel, из которого взяты данные.
  Result := exRng;
end;
 
//Обработчик, который вызывается при щелчке мышью в области таблицы.
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Sg : TStringGrid;
  Col, Row : Integer;
begin
  Sg := Sender as TStringGrid;
  //Определяем координаты ячейки, на которой произошёл щелчок мыши.
  Sg.MouseToCell(X, Y, Col, Row);
  //Если ячейка расположена в области фиксированных ячеек, то выходим.
  if (Row < Sg.FixedRows) or (Col < Sg.FixedCols) then Exit;
  //Если произошёл щелчок левой кнопкой мыши - устанавливаем цвет.
  if Button = mbLeft then begin
    {Под видом указателя на объект, который связан с ячейкой, записываем
    RGB код цвета. Значение, отличное от 0 (нуля), означает, что цвет ячейки
    изменён и под видом указателя записан его RGB код.}
    Sg.Rows[Row].Objects[Col] := TObject(RGB($FF, $99, 0));
  {Если произошёл щелчок правой кнопкой мыши - обнуляем RGB код цвета.
  Здесь следует отменить, что значению = 0 соответствует чёрный цвет, а
  мы задействовали значение 0, как знак того, что цвет не установлен.
  По этой причине нельзя задавать код абсолютного чёрного цвета. Вместо
  него можно задать, например такой: RGB(1, 0, 0).}
  end else if Button = mbRight then begin
    Sg.Rows[Row].Objects[Col] := TObject(0);
  end;
end;
 
//Обработчик, который вызывается при перерисовке ячейки.
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Sg : TStringGrid;
  CellColor : TColor;
begin
  Sg := Sender as TStringGrid;
  //Если ячейка расположена в области фиксированных ячеек, то выходим.
  if (ARow < Sg.FixedRows) or (ACol < Sg.FixedCols) then Exit;
  //Читаем RGB код цвета, который записан под видом указателя на объект.
  CellColor := TColor(Sg.Rows[ARow].Objects[ACol]);
  //Если RGB код равен 0 - выходим.
  if CellColor = 0 then Exit;
  //В противном случае, изменяем цвет ячейки.
  with Sg.Canvas do begin
    //Цвет кисти.
    Brush.Color := CellColor;
    //Заливаем квадрат ячейки цветом кисти.
    FillRect(Rect);
    //Прорисовываем в ячейке текст. Здесь +3 и +2 - так мы задаём ширину
    //полей в ячейке.
    TextOut(Rect.Left + 3, Rect.Top + 2, Sg.Cells[ACol, ARow]);
  end;
end;
 
//Подготовка таблицы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  SgClear(StringGrid1);
end;
 
//Заполнение таблицы данными.
procedure TForm1.Button1Click(Sender: TObject);
var
  i, Row, Col : Integer;
  Sg : TStringGrid;
begin
  Sg := StringGrid1;
  Randomize;
  SgClear(Sg);
  Sg.RowCount := Sg.FixedRows + Random(100);
  i := 0;
  for Row := Sg.FixedRows to Sg.RowCount - 1 do begin
    Inc(i); //Номер строки данных.
    Sg.Cells[0, Row] := FormatFloat('000', i);
    for Col := 0 + 1 to Sg.ColCount - 1 do
      Sg.Cells[Col, Row] := 'Data-' + FormatFloat('000', Random(1000));
  end;
end;
 
//Очистка таблицы.
procedure TForm1.Button2Click(Sender: TObject);
begin
  SgClear(StringGrid1);
end;
 
//Запись данных на лист MS Excel.
procedure TForm1.Button3Click(Sender: TObject);
const
  //Толщина линий.
  xlThin = 2;
  xlMedium = -4138;
  //Вид линии.
  xlContinuous = 1; //Непрерывная линия.
var
  exApp, exBook, exSh, exRng, exRngTmp : Variant;
  i, j : Integer;
  CellColor : TColor;
  Sg : TStringGrid;
  Sd : TSaveDialog;
begin
  Sg := StringGrid1;
  Sd := SaveDialog1; //SaveDialog1 уже должен быть на форме.
  if Sd.InitialDir = '' then
    Sd.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Sd.Execute then Exit;
  if FileExists(Sd.FileName) then begin
    i := MessageBox(0, 'Файл с заданным именем уже существует. Перезаписать?'
      ,'Перезаписать?', MB_YESNO + MB_ICONQUESTION + MB_APPLMODAL);
    if i = IDNO then Exit;
  end;
 
  //Попытка подключиться к корневому объекту MS Excel.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
      'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
    Exit;
  end;
 
  //Делаем видимым окно MS Excel.
  exApp.Visible := True;
  //Создаём рабочую книгу.
  exBook := exApp.WorkBooks.Add;
  //Получаем ссылку на первый лист рабочей книги.
  exSh := exBook.Worksheets[1];
  //Для ускорения работы с MS Excel отключаем режим перерисовки окон MS Excel.
  exApp.ScreenUpdating := False;
  try
    //Удаление прежней таблицы на листе Excel.
    DelExcelTable(exSh, cRow1, cCol1, Sg.ColCount);
    //Передаём данные из таблицы на лист MS Excel. Функция возвращает ссылку
    //на интерфейс диапазона, в который записались данные таблицы.
    exRng := SgToExcel(Sg, exSh, cRow1, cCol1);
    //Линовка всей таблицы.
    exRng.Borders.LineStyle := xlContinuous;
    exRng.Borders.Weight := xlThin;
 
    //Шапка.
 
    //Составляем диапазон шапки.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedRows do
      if i = 1 then
        exRngTmp := exRng.Rows[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRng.Rows[i]);
    //Оформление диапазона шапки.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.Color := RGB($CC, $CC, $CC); //Серый.
    end;
 
    //Заголовочные столбцы.
 
    //Собираем диапазон заголовочных столбцов.
    VarClear(exRngTmp);
    for i := 1 to Sg.FixedCols do
      if i = 1 then
        exRngTmp := exRng.Columns[1]
      else
        exRngTmp := exApp.Union(exRngTmp, exRng.Columns[i]);
    //Оформление диапазона заголовочных столбцов.
    if not VarIsClear(exRngTmp) then begin
      //Шрифт - жирный.
      exRngTmp.Font.Bold := True;
      //Обрамление ячеек.
      exRngTmp.Borders.LineStyle := xlContinuous;
      exRngTmp.Borders.Weight := xlMedium;
      //Цвет фона.
      exRngTmp.Interior.Color := RGB($CC, $CC, $CC); //Серый.
    end;
 
    //Строки данных.
 
    for i := Sg.FixedRows to Sg.RowCount - 1 do
    for j := Sg.FixedCols to Sg.ColCount - 1 do begin
      CellColor := TColor(Sg.Rows[i].Objects[j]);
      if CellColor > 0 then
        exRng.Cells[i + 1, j + 1].Interior.Color := CellColor;
    end;
 
    //Вся таблица.
    //Подбор ширины столбцов по содержимому.
    exRng.Columns.AutoFit;
  finally
    //Включаем режим перерисовки окон MS Excel.
    exApp.ScreenUpdating := True;
  end;
 
  //Сохраняем рабочую книгу.
  //Отключаем режим предупреждений. - Чтобы не выводился диалог о перезаписи
  //файла, если он уже существует.
  exApp.DisplayAlerts := False;
  try
    exBook.SaveAs(FileName:=Sd.FileName);
  finally
    //Включаем режим предупреждений.
    exApp.DisplayAlerts := True;
  end;
 
  //Закрытие рабочей книги MS Excel.
  //exBook.Close;
  //Выход из MS Excel.
  //exApp.Quit;
end;
 
//Чтение данных с листа MS Excel.
procedure TForm1.Button4Click(Sender: TObject);
var
  exApp, exBook, exSh, exRng : Variant;
  i, j : Integer;
  CellColor : TColor;
  Sg : TStringGrid;
  Od : TOpenDialog;
begin
  Sg := StringGrid1;
  Od := OpenDialog1; //OpenDialog1 уже должен быть на форме.
  if Od.InitialDir = '' then
    Od.InitialDir := ExtractFilePath( ParamStr(0) );
  if not Od.Execute then Exit;
  if not FileExists(Od.FileName) then begin
    MessageBox(0, 'Файл с заданным именем не найден. Действие отменено.'
      ,'Файл не найден', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
    Exit;
  end;
 
  //Попытка подключиться к корневому объекту MS Excel.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
      'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
    Exit;
  end;
  //Делаем видимым окно MS Excel. На время отладки или на постоянной основе.
  exApp.Visible := True;
  //Открываем файл рабочей книги.
  exBook := exApp.WorkBooks.Open(FileName:=Od.FileName);
  //Получаем ссылку на первый лист рабочей книги.
  exSh := exBook.Worksheets[1];
  //Получаем данные с листа рабочей книги MS Excel и записываем их
  //в нефиксированные строки таблицы.
  exRng := ExcelToSg(exSh, cRow1, cCol1, Sg);
 
  //Если данных нет, то выходим.
  if VarIsClear(exRng) then Exit;
 
  //Перенос цветов фона.
  for i := Sg.FixedRows to Sg.RowCount - 1 do
  for j := Sg.FixedCols to Sg.ColCount - 1 do begin
    //Получаем RGB код цвета фона в ячейке.
    CellColor := exRng.Cells[i + 1, j + 1].Interior.Color;
    {Если RGB код соответствует абсолютному чёрному цвету (=0), то
    заменяем этот код на ближайший по значению. Потому что у нас
    значение =0 задействовано, как признак того, что цвет не установлен.
    Если RGB код соответствует абсолютному белому цвету, то такой цвет
    можно оставить как есть. Или его можно сделать равным нулю, потому что
    при значении =0 оформление ячейки в нашем коде не выполняется.}
    if CellColor = 0 then
      CellColor := 1 //:= RGB(1, 0, 0);
    else if CellColor = $FFFFFF then
      CellColor := 0;
 
    //Прикрепляем к ячейке TStringGrid полученный RGB код под видом объекта.
    Sg.Rows[i].Objects[j] := TObject(CellColor);
  end;
end;
 
end.

@HyperZen · 07.04.2020, 06:34

Туплю...
А как перенести цвета строк TStringGrid во всеми любимый Excel, если строки разукрашены по определенным условиям (в зависимости от введенных значений в ячейках)?

@D1973 · 07.04.2020, 06:53

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

если строки разукрашены по определенным условиям

Вышеприведенный код демонстрирует перенос окрашивания только в том случае, когда вся строка Стринггрида окрашена целиком одним цветом. И если у Вас в строках сетки каждая ячейка своего цвета - то этот алгоритм Вам не подходит...

@HyperZen · 07.04.2020, 10:19

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

И если у Вас в строках сетки каждая ячейка своего цвета

Как раз вся строка и разукрашена определенным цветом в зависимости от значения в определенной ячейке.
Если Fixed-ячейки разукрашены особенным цветом, данный алгоритм тоже не подходит?

@D1973 · 07.04.2020, 10:36

Да, фиксированные строки и столбцы не включаются в обработку... Но Вы же можете их включить и посмотреть, что выйдет...

@HyperZen · 07.04.2020, 12:43

Изменил пример многоуважаемого Mawrat'а... Что не так?!

@D1973 · 07.04.2020, 13:48

Не по теме:

Эх-х-х... Не получится у меня сейчас глянуть, нет пока Офиса...

@HyperZen · 07.04.2020, 13:50

Не по теме:

Я терпеливый, подожду... ))

@mr-Crocodile · 07.04.2020, 14:37

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

Что не так?!

всё так. Но ваши цвета в таблице рисуются только при отображении (событие StringGrid1DrawCell)

а код берёт цвет ячейки из поля Object грида
у Mawrat процедура StringGrid1DrawCell берёт цвет там же:

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

Delphi

1 2	//Читаем RGB код цвета, который записан под видом указателя на объект. CellColor := TColor(Sg.Rows[ARow].Objects[ACol])

Вам не нужно трогать этот код метода рисования. Оставьте его В НЕТРОНУТОМ ВИДЕ.
ну, если хотите - выбросите

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

Delphi

1	if (Row < Sg.FixedRows) or (Col < Sg.FixedCols) then Exit;

а задание цвета в коде Mawrat, в строчке 186

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

Delphi

if Button = mbLeft then begin
    {Под видом указателя на объект, который связан с ячейкой, записываем
    RGB код цвета. Значение, отличное от 0 (нуля), означает, что цвет ячейки
    изменён и под видом указателя записан его RGB код.}
    Sg.Rows[Row].Objects[Col] := TObject(RGB($FF, $99, 0));

у него цвет задаётся кликом левой кнопки мышки (правая стирает цвет)

Добавлено через 2 минуты
как то сумбурно получилось. Пока писал, мне казалось, что всё понятно. Перечитал. Понял, что не очень понятно...
суть в том, что процедуру StringGrid1DrawCell тебе трогать не надо. цвет нужно задавать в .Objects[]
тогда всё заработает корректно.

сейчас попытаюсь исправить твой пример.

Добавлено через 21 минуту

Delphi

//Заполнение таблицы данными.
procedure TForm1.Button1Click(Sender: TObject);
var
  i, Row, Col : Integer;
  Sg : TStringGrid;
begin
  Sg := StringGrid1;
  Randomize;
  SgClear(Sg);
 
  // зададим серый цвет для шапки таблицы
  for Col := 0 to Sg.ColCount - 1 do
    Sg.Rows[0].Objects[Col] := TObject(RGB($CC, $CC, $CC)); // clGrey - сервый цвет
 
  // количество строк - случайное число от 1 до 100
  Sg.RowCount := Sg.FixedRows + 1 + Random(100);
 
  i := 0;
  for Row := Sg.FixedRows to Sg.RowCount - 1 do begin
    Inc(i); //Номер строки данных.
    Sg.Cells[0, Row] := FormatFloat('000', i);
    Sg.Rows[Row].Objects[0] := TObject(RGB($CC, $CC, $CC)); // clGrey - сервый цвет
    for Col := 0 + 1 to Sg.ColCount - 1 do begin
      Sg.Cells[Col, Row] := 'Data-' + FormatFloat('000', Random(1000));
      if (i=1) or (i=4) then
          Sg.Rows[Row].Objects[Col] := TObject( RGB(250, 180, 180)) // красный
      else
          Sg.Rows[Row].Objects[Col] := TObject( RGB(197, 244, 178)); // светло-зеленый
    end;
  end;
end;

а процедура рисования исходная

Delphi

//Обработчик, который вызывается при перерисовке ячейки.
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Sg : TStringGrid;
  CellColor : TColor;
begin
  Sg := Sender as TStringGrid;
 
  //Читаем RGB код цвета, который записан под видом указателя на объект.
  CellColor := TColor(Sg.Rows[ARow].Objects[ACol]);
  //Если RGB код равен 0 - выходим.
  if CellColor = 0 then Exit;
  //В противном случае, изменяем цвет ячейки.
  with Sg.Canvas do begin
    //Цвет кисти.
    Brush.Color := CellColor;
    //Заливаем квадрат ячейки цветом кисти.
    FillRect(Rect);
    //Прорисовываем в ячейке текст. Здесь +3 и +2 - так мы задаём ширину
    //полей в ячейке.
    TextOut(Rect.Left + 3, Rect.Top + 2, Sg.Cells[ACol, ARow]);
  end;
end;

остальное я не трогал

@HyperZen · 07.04.2020, 18:51

Не по теме:

Пытаюсь "вкурить" код после полторашки пива, пока не выходит... Копипаста, конечно, сработала, но я чувствую себя не удовлетворенным ))) Хочется понимания...

@mr-Crocodile · 08.04.2020, 11:10

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

Хочется понимания...

Так ты не стесняйся - спрашивай, что непонятно.

главная суть в том, что Mawrat использовал имеющийся в списках функционал - для TString есть свойство Objects

Сообщение от Classes.pas

Delphi

1
2
3

  TStrings = class(TPersistent)
.....
    property Objects[Index: Integer]: TObject read GetObject write PutObject;

Туда можно добавлять ссылку на объект. Т.к. нам ссылку на объект добавлять не нужно, мы можем это поле задействовать под свои нужды и хранить там любое значение размера Integer. TColor как раз такого размера. Единственное, что при сохранении мы используем прямое преобразование типа TObject(<целое число>) - иначе компилятор не даст записать Integer в поле типа TObject,
а когда читаем из этого поля, то выполняем обратное преобразование TColor ( тут прочитанное значение из Objects[] )

вот и всё.
Хочешь - заведи отдельный двухмерный массив и храни цвета в нём. Только не забывай менять размер массива при изменении размера грида.
Но решение с отдельным массивом потребует дополнительно больших объёмов памяти. А пользы от него - не больше, чем от "хакерского" варианта, описанного выше.

@spectr108 1 / 1 / 0 Регистрация: 21.03.2012 Сообщений: 16
		1
	Перенести фон Stringgrid'a в таблицу excel 29.05.2013, 17:32. Показов 4259. Ответов 20 Метки нет (Все метки) Добрый день. В моей программке есть возможность выделять строки другим цветом, и уже 2 дня голову ломаю как скопировать фон стринггрида в ексель,т.е. например есть табличка с данными, допустим 5 строк, я выделил 2 и 4 строку, затем переношу в эксель, и в экселе так же должны быть выделены 2 и 4 строка тем же цветом. И вообще возможно ли это) внизу приложил скриншот как это выглядит в программе например Миниатюры 0

@spectr108 1 / 1 / 0 Регистрация: 21.03.2012 Сообщений: 16
	30.05.2013, 08:17 [ТС]	3
	Канешно спасибо, но это не много не то что я просил, вы просто раскрасили ячейки четные не четные, а я просил чтобы именно фон копировался, как я сказал у меня в программе можно строки выделять, т.е. фон у меня белый, я тыкаю на ctrl+лкм по строке, и она красная становится... я могу так и все таблицу красной сделать, и вот можно чтобы именно фон копировался?) Добавлено через 2 часа 17 минут Что то я стал сомневаться в том возможно ли это)) придумал другой вариант, добавил строчку кода , теперь когда я тыкаю лкм+ctrl по строчке, она также красится в красный и + в отдельной ячейке на этой строке добавляется символ "$". И вот от сюда следует новый вопрос. Как сделать чтобы когда все это переносится в эксель, в экселе искался этот символ $ и если найден то строка в экселе красилась бы в красный цвет? это звучит более реальнее и проще чем я спрашивал выше))) 0

@Mawrat 13104 / 5885 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	30.05.2013, 10:36	4
	Сообщение от spectr108 а я просил чтобы именно фон копировался, как я сказал у меня в программе можно строки выделять, т.е. фон у меня белый, я тыкаю на ctrl+лкм по строке, и она красная становится. Понятно, можно и фон копировать. Я вечером сегодня напишу как это можно сделать. Сообщение от spectr108 придумал другой вариант, добавил строчку кода , теперь когда я тыкаю лкм+ctrl по строчке, она также красится в красный и + в отдельной ячейке на этой строке добавляется символ "$". И вот от сюда следует новый вопрос. Как сделать чтобы когда все это переносится в эксель, в экселе искался этот символ $ и если найден то строка в экселе красилась бы в красный цвет? Здесь немного по-другому надо действовать. В общем, вечером сегодня напишу. Добавлено через 12 минут spectr108, пока посмотри вот эти посты: 1. Меняем цвет ячеек стрингрида. - По левой кнопке мыши ячейка закрашивается, по правой - цвет в ячейке сбрасывается. 2. Раскраска ячеек в stringgrid. - Пометить цветом те ячейки, которые подверглись редактированию. 3. Раскраска StringGrid. 1

@spectr108 1 / 1 / 0 Регистрация: 21.03.2012 Сообщений: 16
	30.05.2013, 10:48 [ТС]	5
	Да спасибо за ссылки) правда я их уже видел. и я сделал так как в первой сылке что ты дал, только я добавил чтобы нужно было ctrl нажимать ещё ))) жду вечером 0

@spectr108 1 / 1 / 0 Регистрация: 21.03.2012 Сообщений: 16
	30.05.2013, 17:49 [ТС]	7
	Огромное при огромное спасибо это все же оказалось реальным и самое смешное что мне пришлось изменить 2 моих строчки на ваши и добавить 4-5 ваших) вроде так немного а так много времени у меня отняло. да и ещё 1 вопрос: сложно ли сделать чтобы из экселя тоже цвет передавался в stringgrid? 1

@spectr108 1 / 1 / 0 Регистрация: 21.03.2012 Сообщений: 16
	31.05.2013, 10:30 [ТС]	9
	Спасибо большое, щас на работе, вечером дома буду попробую вставить в свой код 0

@HyperZen 498 / 251 / 56 Регистрация: 16.06.2011 Сообщений: 904
	07.04.2020, 06:34	11
	Туплю... А как перенести цвета строк TStringGrid во всеми любимый Excel, если строки разукрашены по определенным условиям (в зависимости от введенных значений в ячейках)? 0

@D1973 Модератор 9256 / 6034 / 2379 Регистрация: 21.01.2014 Сообщений: 25,793 Записей в блоге: 3
	07.04.2020, 06:53	12
	Сообщение от HyperZen если строки разукрашены по определенным условиям Вышеприведенный код демонстрирует перенос окрашивания только в том случае, когда `вся строка` Стринггрида окрашена `целиком` одним цветом. И если у Вас в строках сетки каждая ячейка своего цвета - то этот алгоритм Вам не подходит... 1

@HyperZen 498 / 251 / 56 Регистрация: 16.06.2011 Сообщений: 904
	07.04.2020, 10:19	13
	Сообщение от D1973 И если у Вас в строках сетки каждая ячейка своего цвета Как раз вся строка и разукрашена определенным цветом в зависимости от значения в определенной ячейке. Если Fixed-ячейки разукрашены особенным цветом, данный алгоритм тоже не подходит? 0

@D1973 Модератор 9256 / 6034 / 2379 Регистрация: 21.01.2014 Сообщений: 25,793 Записей в блоге: 3
	07.04.2020, 10:36	14
	Да, фиксированные строки и столбцы не включаются в обработку... Но Вы же можете их включить и посмотреть, что выйдет... 1

@D1973
	07.04.2020, 13:48 #16
	Не по теме: Эх-х-х... Не получится у меня сейчас глянуть, нет пока Офиса... 0

@HyperZen
	07.04.2020, 13:50 #17
	Не по теме: Я терпеливый, подожду... )) 0

@HyperZen
	07.04.2020, 18:51 #19
	Не по теме: Пытаюсь "вкурить" код после полторашки пива, пока не выходит... Копипаста, конечно, сработала, но я чувствую себя не удовлетворенным ))) Хочется понимания... 0