Рисунок excel в delphi

I have a question here, I have an application and I need to add images to it. I have tried:

Sheet.Shapes.AddPicture(G_V.Prog_Dir+'pic.BMP',false,true, 190, 10+(15*rowcount), 100, 100 );

it works just fine, but I don’t want to give parameters, I want to insert pictures to specified (and parametric) cells because I need to add picture to the last column of the page; this excel needs to be printed I must mention that. So I tried:

Sheet.Range['E'+inttostr(rowcount),'E'+inttostr(rowcount)].Select;
Sheet.Pictures.Insert(G_V.Prog_Dir+'pic.BMP');

It looks OK at first sight, however I think this code links images to the sheet. For example, I send the created Excel to another computer and these images cannot be seen (I don’t recall the exact error) and when I searched it, I found out that receiving computer needs to have images at the exact path. As a solution to this, «Sheet.Shapes.AddPicture» recommended but
as I stated before, I need another solution here.

I didn’t see anybody experiencing this kind of problem, I hope someone helps me out.

1
2
3

Button1: TButton;
Memo1: TMemo;
OpenDialog1: TOpenDialog;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

uses
  ComObj, Clipbrd;
 
//Определение номера строки, на которой расположена верхняя грань объекта.
function GetRowNum(const aExSheet, aExObj : OleVariant) : Integer;
var
  Height, Y : Extended;
begin
  Result := 0; //Номер очередной строки на листе MS Excel.
  Height := 0; //Вертикальная координата нижней грани очередной строки на листе. Выражена в пунктах (Points).
  Y := aExObj.Top; //Вертикальная координата верхней грани объекта. Выражена в пунктах (Points).
  //Ищем первую строку на листе, у которой нижняя грань расположена ниже верхней грани объекта.
  repeat
    Result := Result + 1;
    Height := Height + aExSheet.Rows[Result].Height;
  until Height > Y;
end;
 
//Определение номера столбца, на котором расположена левая грань объекта.
function GetColNum(const aExSheet, aExObj : OleVariant) : Integer;
var
  Width, X : Extended;
begin
  Result := 0; //Номер очередного столбца на листе MS Excel.
  Width := 0; //Горизонтальная координата правой грани очередного столбца на листе. Выражена в пунктах (Points).
  X := aExObj.Left; //Горизонтальная координата левой грани объекта. Выражена в пунктах (Points).
  //Ищем первый столбец на листе, у которой правая грань расположена правее левой грани объекта.
  repeat
    Result := Result + 1;
    Width := Width + aExSheet.Columns[Result].Width;
  until Width > X;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Константы MS Office/MS Excel.
  msoPicture = 13; //Тип фигуры - изображение.
  xlBitmap = 2; //Тип изображения - Bitmap.
  //Относительный путь к папке с экспортируемыми данными.
  PathExpBase = 'Export';
var
  exApp, exBook, exSh, exShape, exShapes : OleVariant;
  Od : TOpenDialog;
  Cb : TClipboard;
  Bm : TBitmap;
  i, j, Row, Col : Integer;
  Path, PathExp, FileName : String;
begin
  //Путь к папке, в которой расположен исполняемый файл программы.
  //В конце пути расположен слеш "".
  Path := ExtractFilePath(ParamStr(0));
  //Диалог выбора файла.
  Od := OpenDialog1; //OpenDialog1 уже должен быть на форме.
  if Od.InitialDir = '' then
    Od.InitialDir := Path;
  if not Od.Execute then
    Exit;
  if not FileExists(Od.FileName) then
  begin
    MessageBox(Handle, 'Файл с заданным именем не найден! Действие отменено.',
      'Внимание!', MB_OK + MB_ICONWARNING + MB_APPLMODAL);
    Exit;
  end;
  Memo1.Lines.Add('------------------------------');
  Memo1.Lines.Add('Файл рабочей книги: "' + Od.FileName + '"');
 
  //Запуск экземпляра Excel и получение ссылки на корневой объект (Excel.Application).
  exApp := CreateOleObject('Excel.Application');
  exApp.Visible := True; //Делаем видимым окно MS Excel.
  exBook := exApp.Workbooks.Open(FileName:=Od.FileName); //Открываем раб. книгу и получаем ссылку на неё.
 
  Cb := Clipboard; //Объект, представляющий буфер обмена Windows.
  Bm := TBitmap.Create; //Объект, представляющий изображение.
  try
    //Перебор всех рабочих листов в рабочей книге.
    for i := 1 to exBook.Worksheets.Count do
    begin
      exSh := exBook.Worksheets[i]; //Получаем ссылку на очередной рабочий лист.
      exShapes := exSh.Shapes; //Ссылка на коллекцию фигур, связанных с листом.
      //Создаём папку для экспорта выбранной рабочей книги.
      PathExp := Path + PathExpBase + ExtractFileName(Od.FileName) + '' + exSh.Name + '';
      ForceDirectories(PathExp);
      Memo1.Lines.Add('----------');
      Memo1.Lines.Add('Лист: "' + exSh.Name + '"');
      Memo1.Lines.Add('Папка экспорта: "' + PathExp + '"');
      Memo1.Lines.Add('Количество фигур: ' + IntToStr(exShapes.Count));
      //Перебираем элементы коллекции фигур и обрабатываем их.
      for j := 1 to exShapes.Count do
      begin
        exShape := exShapes.Item(j); //Берём очередную фигуру из коллекции.
        Memo1.Lines.Add('Фигура: "' + exShape.Name + '"');
        //Координаты ячейки, на которой лежит верхний левый угол фигуры.
        Row := GetRowNum(exSh, exShape);
        Col := GetColNum(exSh, exShape);
        Memo1.Lines.Add('  Координаты ячейки: Row = ' + IntToStr(Row) + ', Col = ' + IntToStr(Col));
        exShape.CopyPicture(Format:=xlBitmap); //Копируем в буфер обмена изображение в формате Bitmap.
        if Cb.HasFormat(CF_BITMAP) then //Если буфер содержит данные в формате CF_BITMAP.
        begin
          Bm.Assign(Cb); //Забираем изображение из буфера обмена.
          FileName := exShape.Name + '.bmp'; //Имя файла.
          Bm.SaveToFile(PathExp + FileName); //Сохраняем изображение в файл.
          Memo1.Lines.Add('  Изображение сохранено в файл: "' + FileName + '"');
        end
        else
          Memo1.Lines.Add('  Формат отличается от CF_BITMAP. Действие отменено.');
      end;
    end;
  finally
    FreeAndNil(Bm);
    //Экземпляр Cb : TClipboard освобождать не надо - это действие прописано
    //в разделе финализации модуля Clipbrd.
  end;
end;

------------------------------
Файл рабочей книги: "C:ProjCyberXXXX-TestFilesКнига1.xls"
----------
Лист: "Лист1"
Папка экспорта: "C:ProjCyberXXXX-TestExportКнига1.xlsЛист1"
Количество фигур: 6
Фигура: "Picture 1"
  Координаты ячейки: Row = 3, Col = 3
  Изображение сохранено в файл: "Picture 1.bmp"
Фигура: "Picture 2"
  Координаты ячейки: Row = 3, Col = 6
  Изображение сохранено в файл: "Picture 2.bmp"
Фигура: "Picture 3"
  Координаты ячейки: Row = 3, Col = 9
  Изображение сохранено в файл: "Picture 3.bmp"
Фигура: "Picture 4"
  Координаты ячейки: Row = 3, Col = 12
  Изображение сохранено в файл: "Picture 4.bmp"
Фигура: "AutoShape 5"
  Координаты ячейки: Row = 10, Col = 2
  Изображение сохранено в файл: "AutoShape 5.bmp"
Фигура: "AutoShape 6"
  Координаты ячейки: Row = 12, Col = 4
  Изображение сохранено в файл: "AutoShape 6.bmp"
----------
Лист: "Лист2"
Папка экспорта: "C:ProjCyberXXXX-TestExportКнига1.xlsЛист2"
Количество фигур: 0
----------
Лист: "Лист3"
Папка экспорта: "C:ProjCyberXXXX-TestExportКнига1.xlsЛист3"
Количество фигур: 2
Фигура: "Рисунок 1"
  Координаты ячейки: Row = 4, Col = 4
  Изображение сохранено в файл: "Рисунок 1.bmp"
Фигура: "Рисунок 2"
  Координаты ячейки: Row = 10, Col = 8
  Изображение сохранено в файл: "Рисунок 2.bmp"

0

← →
Ragazor
 
(2004-08-28 19:03)
[0]

сабж

← →
YurikGL ©
 
(2004-08-30 07:26)
[1]

Как вариант запустить Excel потом нужную картинку сделать select а потом copytoclipboard

← →
VMcL ©
 
(2004-08-30 10:17)
[2]

← →
Ragazor
 
(2004-08-30 11:20)
[3]

хммм…
А если картинка не одна, тоесть типа нужно выбрать картинку с нужным названием и потом копировать.

← →
Ragazor
 
(2004-08-30 11:36)
[4]

ActiveSheet.Shapes(…).Select
такой синтаксис требует «member not found»

← →
YurikGL ©
 
(2004-08-31 10:45)
[5]

> Ragazor   (30.08.04 11:36) [4]

Сделай макрос и посмотри его синтаксис

← →
Ragazor
 
(2004-09-03 12:18)
[6]

я сделал, там надо вписать типа имя картинки вида «Картинка1»
но в делфи так не проходит.

← →
YurikGL ©
 
(2004-09-03 13:35)
[7]

← →
Ragazor
 
(2004-09-03 13:55)
[8]

а я прбовал
ActiveSheet.Shapes(«Картинка 1»).Select

← →
Ragazor
 
(2004-09-03 14:30)
[9]

← →
YurikGL ©
 
(2004-09-03 15:27)
[10]

Как вариант — через буфер.

← →
Ragazor
 
(2004-09-05 13:54)
[11]

Update #4 The OP belatedly provided instructions to prepare an example of the picture he’s been trying to extract:

1) Go to nbbclubsites.nl/club/8000/uitslagen 2) Click on «TKDmm, ronde 1 [1]» 3) Click on -14- 13/3 4) Clik on «B.C. Den Dungen-1» 5) Select de 4 and hearts symbol 6) Copy Ctrl+C 7) Open Excel and select cell (1,1) Past Ctrl+V In the cell you see 4 in the cell and the heart symbol locked left upper corner

I did this and the hearts symbol pasted into my worksheet without any problem. After doing that, the SavePicture method in item 1 Insert Picture correctly extracts and saves the hearts symbol to disk as a .Jpg file. Doh!

Update #3 A problem with answering this question has been that there is no
information about how the pictures in the OP’s spreadsheet have been inserted. So far,
three different methods have been identified namely:

• Using Insert — Picture from Excel’s Insert Tab
• Using Insert — Object from Excel’s Insert Tab
• Using Insert Comment from the selected cell’s context menu

Below I show code examples for each of these methods.

1. Insert — Picture

procedure TForm1.InsertPicture;
begin
  Worksheet.Pictures.Insert('C:UsersmaPicturesphoto-2.JPG');
end;

procedure TForm1.SavePicture;
var
  Picture : OleVariant;
begin
  Picture := Worksheet.Pictures[1];
  Picture.Select;
  Picture.Copy;
  SaveClipboard;
end;

2. Insert — Object

procedure TForm1.InsertAsObject;
begin
  WorkSheet.OLEObjects.Add(Filename:='C:UsersmaPictureswall.bmp', Link :=False,
    DisplayAsIcon:=False).Select;
end;

procedure TForm1.SaveObjectBmp;
var
  Shape : OleVariant;
begin
  Caption := IntToStr(WorkSheet.OleObjects.Count);
  WorkSheet.OLEObjects[1].Select;
  WorkSheet.OLEObjects[1].CopyPicture;
  Shape := WorkSheet.OLEObjects[1].ShapeRange.Item(1);
  Shape.CopyPicture(xlScreen, xlBitMap);
  SaveClipboard;
end;

3. Insert as cell comment

procedure TForm1.InsertCommentPicture;
var
  Cell,
  Comment : OleVariant;
begin
  Cell := WorkSheet.Cells.Range['b2', 'b2'];
  Comment := Cell.AddComment;
  Comment.Shape.Fill.UserPicture('C:UsersmaPicturesphoto-2.JPG');
  Comment.Visible := True;
end;

procedure TForm1.SaveCommentPicture;
var
  Cell,
  Comment,
  Shape,
  Picture : OleVariant;
begin
  Cell := WorkSheet.Cells.Range['B2', 'B2'];
  Comment := Cell.Comment;
  Comment.Visible := True;

  Shape := Comment.Shape;
  Shape.CopyPicture(xlScreen, xlBitMap);
  SaveClipBoard;
end;

The SaveClipBoard method and FormCreate method are shown below. Excel, WorkBook
and WorkSheet are all OleVariant members of the form.

procedure TForm1.SaveClipboard;
// With thanks to the author of http://delphi.cjcsoft.net/viewthread.php?tid=46877
var
  myBitmap: TBitmap;
  myJpegImg: TJpegImage;
  SaveFileName: string;
begin
  Caption := IntToStr(Clipboard.FormatCount)  + ':' + IntToStr(Clipboard.Formats[0]);
  SaveFileName := ExtractFilePath(FileName) + 'Saved.Jpg';
  myBitmap := TBitmap.Create;
  myJpegImg := TJpegImage.Create;
  try
    if Clipboard.HasFormat(cf_Bitmap) then
      begin
        myBitmap.Assign(clipboard);
        myJpegImg.Assign(myBitmap);
        myJpegImg.SaveToFile(SaveFileName);
      end
    else
      ShowMessage('No graphic on the clipboard');
  finally
    myBitmap.FreeImage;
    myJpegImg.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Excel := CreateOleObject('Excel.Application');
  Excel.Visible := True;
  FileName := ExtractFilePath(Application.ExeName) + 'PictureBook.Xlsx';
  WorkBook := Excel.Workbooks.Open(FileName);
  WorkSheet := WorkBook.ActiveSheet;
end;

У меня есть вопрос, у меня есть приложение, и мне нужно добавить к нему изображения. Я пытался:

Sheet.Shapes.AddPicture(G_V.Prog_Dir+'pic.BMP',false,true, 190, 10+(15*rowcount), 100, 100 );

он работает нормально, но я не хочу давать параметры, я хочу вставлять изображения в указанные (и параметрические) ячейки, потому что мне нужно добавить изображение в последний столбец страницы; это превосходство должно быть напечатано, я должен упомянуть об этом. Поэтому я попробовал:

Sheet.Range['E'+inttostr(rowcount),'E'+inttostr(rowcount)].Select;
Sheet.Pictures.Insert(G_V.Prog_Dir+'pic.BMP');

С первого взгляда это выглядит нормально, однако я думаю, что этот код связывает изображения с листом. Например, я отправляю созданный Excel на другой компьютер, и эти изображения не могут быть замечены (я не помню точную ошибку), и когда я его обыскал, я узнал, что на компьютере-получателе должны быть изображения с точным путем. В качестве решения этого «Sheet.Shapes.AddPicture» рекомендуется, но, как я уже говорил, мне нужно другое решение.

Я не видел, чтобы кто-то испытывал подобные проблемы, я надеюсь, что кто-то поможет мне.

уважаемые посетители блога, если Вам понравилась, то, пожалуйста, помогите автору с лечением. Подробности тут.

Сегодня мы рассмотрим один из наиболее интересных, на мой взгляд, моментов работы с Excel в Delphi — построение диаграмм.

Забегая немного вперед, скажу, что есть несколько способов добавления диаграммы в рабочую книгу Excel.  Чтобы все статьи по вопросам автоматизации Excel в блоге были как-то логически связаны, я решил сегодня рассмотреть способ добавления диаграммы через объект ChartObjects, с которым мы встречались, когда разбирали методы объекта WorkSheet.

План статьи:

• Копируем данные из таблицы и оформление StringGrid
• Добавление и редактирование диаграммы Excel

Итак, поставим перед собой цель — построить простой линейный график на основании данных таблицы (StringGrid) нашего приложения. При этом, чтобы продолжить предыдущую тему, постараемся скопировать таблицу на лист один-к-одному.

1. Копируем данные из таблицы и оформление StringGrid.

Для копирования данных из таблицы на лист Excel воспользуемся простейшей процедурой, которую мы уже с Вами рассматривали. Для наглядности, приведу листинг процедуры ещё раз:

procedure WriteTable(FirstCol, FirstRow:integer; Grid: TStringGrid);
var col,row:integer;
begin
  try
    for col := 0 to Grid.ColCount - 1 do
      for row := 0 to Grid.RowCount - 1 do
        MyExcel.ActiveWorkBook.ActiveSheet.Cells[FirstRow+row, FirstCol+col]:=Grid.Cells[col, row];
  except
    raise Exception.Create('Запись таблицы завершилась ошибкой')
  end;
end;

Теперь начнем копировать оформление. Во-первых, необходимо определить свойство BorderStyle у StringGrid — оно может быть либо bsSingle либо bsNone. В первом случае внешние границы таблицы будут выделяться. Отсюда следует, что и наша таблица в Excel должна иметь окантовку. Делается это просто:

...
 
if Grid.BorderStyle=bsSingle then
begin
  //отрисовываем внешние границы сплошной линией
  Range1.Borders[xlEdgeBottom].LineStyle:=xlContinuous;
  Range1.Borders[xlEdgeTop].LineStyle:=xlContinuous;
  Range1.Borders[xlEdgeLeft].LineStyle:=xlContinuous;
  Range1.Borders[xlEdgeRight].LineStyle:=xlContinuous;
end;
 
...

Во-вторых, StringGrid может быть с отрисованными внутренними линиями и без них. За отрисовку внутренних линий отвечают два параметра из свойства Options у StringGrid: goFixedVertLine (прорисовка вертикальных линий в ) и goFixedHorzLine (прорисовка горизонтальных линий в StringGrid).

Проверяем наш StringGrid и, в случае необходимости, прорисовываем внутренние границы ячеек:

if goFixedVertLine in Grid.Options then
  Range1.Borders[xlInsideVertical].LineStyle:=xlSolid;
if goFixedHorzLine in Grid.Options then
  Range1.Borders[xlInsideHorizontal].LineStyle:=xlContinuous;

А теперь самое интересное — определение цветов StringGrid и перенос их в таблицу Excel.  Для того, чтобы перевести цвет в Delphi в цвет, приемлемый для Excel, напишем небольшую подпрограмму:

R := GetRValue(ColorToRGB(Color));
G := GetGValue(ColorToRGB(Color));
B := GetBValue(ColorToRGB(Color));

где Color — это любой из цветов в Delphi, например clRed или clBtnFace. В итоге мы получим три составляющих для RGB, который допускается использовать при заливке ячеек в Excel.

Теперь можно копировать цвета фиксированных ячеек StringGrid:

Cell1:=MyExcel.ActiveWorkBook.ActiveSheet.Cells[FirstRow, FirstCol];
Cell2:=MyExcel.ActiveWorkBook.ActiveSheet.Cells[FirstRow+Grid.RowCount-1, FirstCol+Grid.ColCount-1];
//выделяем занятую таблицей область листа
Range1:=MyExcel.ActiveWorkBook.ActiveSheet.Range[Cell1, Cell2];
 
if Grid.FixedCols>0 then //есть фиксированные колонки
for I:=1 to Grid.FixedCols do
Range1.Columns[i].Interior.Color:=RGB(r,g,b);
if Grid.FixedRows>0 then //есть фиксированные строки
for I:=1 to Grid.FixedRows do
Range1.Rows[i].Interior.Color:=RGB(r,g,b);

Таким образом мы скопировали наш StringGrid на лист Excel. Конечно, здесь есть свои недостатки, например StringGrid может быть раскрашен как новогодняя ёлка или иметь совершенно иное оформление, чем стандартное и тогда, следуя вышеперечисленным операциям Вы не добьетесь копирования оформления один-к-одному. Но, при небольшом дополнении исходного кода этого можно легко добиться — суть вопроса остается той же, как и набор операций работы Delphi с Excel.

2. Добавление и редактирование диаграммы Excel

Теперь, имея в своем распоряжении данные, можно приступать к построению диаграммы Excel с помощью Delphi.

Для того, чтобы добавить в коллекцию ChartObjects новый объект необходимо выполнить метод Add:

ChartObjects.Add(Left, Top, Width, Height)

где:

Left и Top — начальные координаты нового объекта (в пикселях), относительно левого верхнего угла ячейки A1 на листе или в левом верхнем углу графика.

Width и Height — соответственно ширина и высота новой диаграммы.

В результате выполнения метода в коллекцию ChartObjects добавляется новый объект. Пока никаких данных объект не использует. По сути в добавляется пустой холст диаграмм Excel.

Для того, чтобы построить диаграмму, необходимо:

• получить ссылку на объект Chart из коллекции ChartObjects;
• воспользоваться методом ChartWizard

Чтобы получить ссылку на вновь добавленный объект необходимо выполнить следующую операцию:

var Chart: OLEVariant;
 
ChartCount: integer;
 
begin
 
...
 
ChartCount:=MyExcel.ActiveWorkBook.ActiveSheet.ChartObjects.Count;
 
Chart:=MyExcel.ActiveWorkBook.ActiveSheet.ChartObjects[ChartCount].Chart;
 
...
 
end;

Метод ChartWizard содержит следующие параметры:

ChartWizard(Source, Gallery, Format, PlotBy, CategoryLabels, SeriesLabels, HasLegend, Title, CategoryTitle, ValueTitle, ExtraTitle)

Как и для любых других методов Excel, в Delphi допускается опускать некоторые параметры или отмечать их как EmptyParam.

Теперь построим наш график. Для этого я написал небольшую процедуру:

procedure AddLineChartFromTable(X, Y, Height, Width, Format: integer; Title, XLabel,YLabel: string; DataGrid: TStringGrid; DataPosition: byte; ChartType:integer);
var Chart: OLEVariant;
  DataRange: OLEVariant;
begin
//Вставляем данные из таблицы
  WriteTable(1, 1, DataGrid);
//выбираем данные для диаграммы
  DataRange:=MyExcel.ActiveWorkBook.ActiveSheet.UsedRange;
//добавляем новую диаграмму на активный лист
  MyExcel.ActiveWorkBook.ActiveSheet.ChartObjects.Add(x,y,width,height);
//выбираем последнюю добавленную диаграмму
  Chart:=MyExcel.ActiveWorkBook.ActiveSheet.ChartObjects[MyExcel.ActiveWorkBook.ActiveSheet.ChartObjects.Count];
  Chart.Chart.ChartWizard(Source:=DataRange,
  Gallery:=xlLine,
  Format:=Format,
  PlotBy:=DataPosition,
  CategoryLabels:=1,
  SeriesLabels:=1,
  HasLegend:=true,
  Title:=Title,
  CategoryTitle:=XLabel,
  ValueTitle:=YLabel);
end;

Как видите, все достаточно просто. Берется таблица StringGrid, данные из неё переносятся в Excel на активный лист и, затем, эти данные используются для построения графика. Причём первая ячейка таблицы используется для подписи рядов данных. В результате выполнения процедуры я получил следующую диаграмму Excel:

Ну, и наконец, для того, чтобы представить этот же график в объемном виде, воспользуемся одним из многочисленных свойств объекта Chart — ChartType:

Chart.ChartType:=xl3DLine;

в итоге получим следующий вид диаграммы:

На сегодня все В следующий раз займемся свойствами объекта Chart, научимся строить различные типы диаграмм и изменять область построения диаграммы. А пока можете поэкспериментировать с параметрами у ChartWizard  и посмотреть какие ещё виды диаграмм Excel Вы сможете построить в Delphi.

Книжная полка

Название:Разработка приложений Microsoft Office 2007 в Delphi Описание Описаны общие подходы к программированию приложений MS Office. Даны программные методы реализации функций MS Excel, MS Word, MS Access и MS Outlook в среде Delphi.

уважаемые посетители блога, если Вам понравилась, то, пожалуйста, помогите автору с лечением. Подробности тут.