急求！！！怎么将图片导出到EXCEL中

[liangwen1992]

，像这个一样，左上角的图片怎么导到excel中，寻求大神帮助！！

[WorldMobile]

用vba连接excel，把图片导入到excel里，参考以下代码 三、导数据到EXCEL的方法： 1> 先COPY行，在写数据到行的单元格 做一个EXCEL模板 启用巨集 巨集代码如下： Sub copy() Range("a4:r4").Select //复制行 Selection.copy End Sub Sub paste(xrows As String) Range(xrows).Select ActiveSheet.paste End Sub 在PB各式里写一个按钮的click事件（也可以写一个转EXCEL的函数） long ret,i, rows OLEObject xlapp pointer oldpointer oldpointer=setpointer(hourglass!) xlApp = Create OLEObject ret = xlApp.ConnectToNewObject( "Excel.Application" ) if ret < 0 then MessageBox("Connect to Excel Failed !",string(ret)) setpointer(oldpointer) return end if xlApp.Application.Workbooks.Open("C:/excel/test.xls") xlApp.Application.Visible = true xlapp.application.activeworkbook.sheets("test").select //调用模板 xlApp.Application.run("copy") //COPY行 rows=dw_2.rowcount() if rows<=0 then return 1 for i=2 to rows if i<=dw_2.rowcount() then xlApp.Application.run("paste","a"+string(i+1)) xlApp.application.activeworkbook.worksheets[1].cells[i+1,4]=string(dw_2.object.c_date[i],"mm/dd/yyyy")//写日期数据到EXCEL单元格里 next //save EXCEL integer value string docname, named value = GetFileSaveName("Select File", docname, named, "xls", " Excel Files (*.xls), *.xls") // 导出图片 pictname=dw_4.object.i_photoname[r] xlsub1.Range("N9").Select if pictname<>'' and not(isnull(pictname)) then if flg = 0 then flg = photoexist(pictname) if FILEEXISTS(pictname) = true then xlapp.Application.ActiveSheet.Pictures.Insert(string(pictname)).select xlapp.Application.Selection.ShapeRange.height=180 //图片的大小 end if end if xlApp.DisConnectObject() Destroy xlapp setpointer(oldpointer) 2> COPY多行，在写数据到行的单元格 不同的ITEM在一个页面放的数量>3个以上 转数据到EXCEL时，要对模板多行COPY格式 代码如下 //定义变量 double jpgsize string pictname,aa,ff,ctn long i=1,k,m,b,numrows,f,flg numrows=dw_2.rowcount()// 取总行数 K=CEILING(numrows/5) //每页总行数除去5个ITEM xls=xlapp.application.activeworkbook xlsub=xlapp.application.activeworkbook.worksheets[1] for i=1 to k - 1 b=50*i+1 aa='A'+string(B) xlapp.Application.range("A1:N50").Select xlapp.Application.Selection.Copy xlapp.Application.range(AA).Select xlapp.Application.Selection.Insert() next xlapp.Application.cutcopymode=false //每次10 COPY for i=1 to numrows xlsub.Cells[10*(i - 1)+9,12]=string(round(dw_2.object.q_l[i],2),"#,##0.00")+" x "+string(round(dw_2.object.q_w,2),"#,##0.00")+" x "+string(round(dw_2.object.q_h[i],2),"#,##0.00")// 长*宽*高 //转图片 pictname=dw_2.object.i_photoname[i] f=10*(i - 1)+2 ff="N"+string(f) xlapp.Application.ActiveWorkbook.Worksheets[1].Range(ff).Select if pictname<>'' and not(isnull(pictname)) then if GetJpgSize(pictname)<>0 then xlapp.Application.ActiveSheet.Pictures.Insert(string(pictname)).select if GetJpgSize(pictname)<1.29 then xlapp.Application.Selection.ShapeRange.height = 215 else xlapp.Application.Selection.ShapeRange.Width = 255 end if end if end if next