请高手进入 转信息到Excel的问题

[lovelwx]

如何将数据表中的数据转到Excel的同时,也能够将此条信息链接的图片文件插入Excel 中,即有一条信息1111,222,2222 它链接的图片文件为D:\ABC\111.jpg 在转出的同时也将此张图片按自定的 高宽 插入到Excel 中呢?

[tiexinliu]

//在当前选定单元格插入图片
Sheet.Pictures.Insert(imgFile).Select;
//移动图片
eclApp.Selection.ShapeRange.IncrementLeft(180);
eclApp.Selection.ShapeRange.IncrementTop(-30);

[tiexinliu]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
ComObj;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure setEclStyle;
procedure drawImg;
function getColChar(col: Integer): string;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
eclApp: Variant;
imgFile: string;

const
rowStart = 6;
colStart = 3;


//生成99乘法表
procedure TForm1.Button1Click(Sender: TObject);
var
i,j: Integer;
row,col: Integer;
begin
try
//创建OLE对象Excel Application与 WorkBook
eclApp:= CreateOleObject('Excel.Application');
eclApp.workBooks.Add;
except
messagebox(handle,'您的机器里可能未安装Microsoft Excel或异常','无法生成',MB_OK or MB_ICONWARNING);
Exit;
end;

eclApp.visible:= True;

Hide; //生成过程将程序隐藏
try
for i:= 1 to 9 do
begin
eclApp.Cells(rowStart, colStart + i):= i;
eclApp.Cells(rowStart + i, colStart):= i;
for j:= 1 to 9 do
begin
row:= rowStart + i;
col:= colStart + j;
eclApp.Cells(row, col):= i * j;

//设置字体,底框颜色 颜色值为 $00BBGGRR
if i < j then
begin
eclApp.Cells.item[row,col].Font.Color:= $00FF0000;
eclApp.Cells.item[row,col].Interior.Pattern:= 1;
eclApp.cells.item[row,col].Interior.ColorIndex:= 12;
end
else if i > j then
begin
eclApp.Cells.item[row,col].Font.Color:= $0000FF00;
eclApp.Cells.item[row,col].Interior.Pattern:= 1;
eclApp.cells.item[row,col].Interior.ColorIndex:= 9;
end
else begin
eclApp.Cells.item[row,col].Font.Color:= $000000FF;
eclApp.Cells.item[row,col].Interior.Pattern:= 1;
eclApp.cells.item[row,col].Interior.ColorIndex:= 6;
end;
end;
end;
SetEclStyle;
//设置纸线为横向
eclApp.ActiveSheet.PageSetup.Orientation:= 2;
finally
Show;
end;
Application.BringToFront; //将应用程序提前
messagebox(handle,'生成完毕，您可以再进行编辑并存盘','生成成功',MB_OK or MB_ICONINFORMATION);
end;

//关闭程序时，释放Excel应用对象
procedure TForm1.FormDestroy(Sender: TObject);
begin
//关闭eclApp
//若不进行这一步，在任务管理器中会驻留Excel进程
//但可以不必关闭Excel (eclApp.Quit),这样，操作员可以继续编辑或打印表格
eclApp:= Unassigned;
end;

//设置表格的显示样式
procedure TForm1.setEclStyle;
var
Sheet, Range:Variant;
s: string;
rct: TRect;
begin

Sheet:= eclApp.WorkBooks[1].WorkSheets[1];

s:= Format('%s%d:%s%d',[getColChar(colStart),
rowStart,
getColChar(colStart + 9),
rowStart + 9]);
Range:= Sheet.Range[s]; //得到区域对象

Range.Font.Name:= 'Tahoma';
Range.Font.Bold:= True;

//设置区域的外框线型
// 1: Left, 2: Right, 3: Top, 4: bottom
// 5: \, 6: / (斜线)
// 7: Left, 8: Top, 9: bottom, 10: Right （不包括内部单元格)
// 11, 12 , 内部单元格线条 (分别是竖线和横线，12我用了没效果)
Range.Borders[7].LineStyle:= 1;
Range.Borders[7].Weight:= 3;
Range.Borders[8].LineStyle:= 1;
Range.Borders[8].Weight:= 3;
Range.Borders[9].LineStyle:= 1;
Range.Borders[9].Weight:= 3;
Range.Borders[10].LineStyle:= 1;
Range.Borders[10].Weight:= 3;

Range.Borders[11].LineStyle:= 1;
Range.Borders[11].Weight:= 2;
Range.Borders[11].ColorIndex:= 2;
Range.Borders[12].LineStyle:= 1;
Range.Borders[12].Weight:= 2;
Range.Borders[12].ColorIndex:= 2;

//水平，垂直对齐方式
Range.HorizontalAlignment:= 3;
Range.VerticalAlignment:= 2;

//单元格行高，列宽
Range.ColumnWidth:= 9;
Range.RowHeight:= 18;

//设置表头
s:= Format('%s%d:%0:s%2:d',[getColChar(colStart),
rowStart,
rowStart + 9]);
Range:= Sheet.Range[s]; //得到区域对象
Range.ColumnWidth:= 5;
Range.Interior.Pattern:= 1;
Range.Interior.ColorIndex:= 3;

s:= Format('%s%d:%s%1:d',[getColChar(colStart + 1),
rowStart,
getColChar(colStart + 9)]);
Range:= Sheet.Range[s]; //得到区域对象
Range.Interior.Pattern:= 1;
Range.Interior.ColorIndex:= 3;

//表格标题
s:= Format('%s%d:%s%1:d',[getColChar(colStart),
rowStart - 2,
getColChar(colStart + 9)]);
Range:= Sheet.Range[s];

//合并单元格
Range.Merge;
Range.Select;
//============================================
//在当前选定单元格插入图片
Sheet.Pictures.Insert(imgFile).Select;
//移动图片
eclApp.Selection.ShapeRange.IncrementLeft(180);
eclApp.Selection.ShapeRange.IncrementTop(-30);

rct.Left:= Range.Left;
rct.Top:= Range.Top;
rct.Right:= rct.Left + Range.Width;
rct.Bottom:= rct.Top + Range.Height;
//在指定坐标添加线条
Sheet.Shapes.AddLine(rct.Left,rct.Top,rct.Right,rct.Top).Select;
eclApp.Selection.ShapeRange.IncrementTop(18);
eclApp.Selection.ShapeRange.Line.Weight:= 2.25;
//在指定坐标添加文本框 并选定
Sheet.Shapes.AddTextBox(1,rct.Right - 160,rct.Top,160,16).Select;
eclApp.Selection.Characters.Text:= 'Design By Mostone.Jiang';
//选中字符的起始位置与长度（长度省去则包含所有后面的字符)
eclApp.Selection.Characters(11,13).Font.FontStyle:= '加粗 倾斜';
eclApp.Selection.Characters(11,13).Font.Underline:= 1;
eclApp.Selection.Characters(11,13).Font.colorIndex:= 46;
eclApp.Selection.Font.Name:= 'Tahoma';
eclApp.Selection.ShapeRange.Fill.Visible := 0;
eclApp.Selection.ShapeRange.Line.Visible := 0;


end;

//程序启动时，创建一张图片，用来插入到生成的Excel表格中
procedure TForm1.FormCreate(Sender: TObject);
var
d: Word;
buf: array[0..255] of char;
begin
d:= GetTempPath(sizeof(buf),buf);
if d > 0 then
begin
imgFile:= buf + 'imgTL.jpg';
drawImg; //调用自定义过程，绘制图形并保存到临时目录
//也可以考虑使用剪贴板
end
else messagebox(handle,'无法得到临时目录!\n你可以继续运行程序\n但是生成的Excel表格将没有图例','取临时文件出错',MB_OK or MB_ICONINFORMATION);
end;

//随便画张图
procedure TForm1.drawImg;
var
bitMap: TBitMap;
w,h: Integer;
begin
W:= 268;
H:= 50;
bitMap:= TBitMap.Create;
try
bitMap.Width:= W;
bitMap.Height:= H;
with bitMap.Canvas do
begin
Font.Size:= 36;
Font.Name:= '隶书';

Brush.Style:= bsClear;

TextOut(5,9, '九九乘法表');
TextOut(5,5, '○○');
end;
bitMap.SaveToFile(imgFile);
finally
bitMap.Free;
end;
end;

//返回列的字符表示符
function TForm1.getColChar(col: Integer): string;
const
Ai = 65; //'A'的ASCII码值
begin
if col > 256 then
begin
//允许的最大列数
raise ERangeError.CreateFmt('列(%d)超出允许的最大列数[256]', [col]);
exit
end;
if col <= 26 then Result:= chr(Ai + col -1) else
Result:= chr(Ai + col div 26 - 1) + chr(Ai + (col - 1) mod 26);
end;

end.

[tiexinliu]

http://expert.csdn.net/Expert/topic/2357/2357198.xml?temp=.3296167

[hmily1688]

嘻嘻，我是来学习的，

[ujjcel]

转换图片我不会，关注。

[webwolfa]

用delphi下的控件解决以上问题很简单的，用servers面版下的excelapplicaton,excelbook,
excelsheet,等等，提个见意，你自已支看看吧、祝你好运。

[gongags]

我也想學學...,

[ly_liuyang]

组件ExcelExport最好用的