【83期】Image控件调用工作表单元格图片或批注图片[已小结]

zhaogang1960

小结：

首先感谢冻版主把此题目从开放式竞赛专区转为正式竞赛题。

本题原来目的在于挖掘调用excel中的单元格或批注中图片更简单的方法，为了不限制大家的思路，取消了api技术的限制。使用api或图表技术调用excel单元格或批注中图片是成熟技术，论坛中有很多例子，大家有兴趣可以搜一下，下面链接是一个api技术调用excel中图片例子：

VBA调用excel中的图片

http://club.excelhome.net/thread-372773-1-1.html

使用另存为网页可以分离出excel单元格或批注中图片，7楼oyzhjr坛友使用的就是此法，Excel2003另存为网页可以得到jpg图片，默认情况下20072010分离单元格图片却是png图片，这时需要设定DefaultWebOptions对象的AllowPNG属性，可分离出gif图片：

Application.DefaultWebOptions.AllowPNG= False

下面给出这种简单方法的代码和附件

1、Image控件调用工作表单元格图片(兼容20072010)

1. Private Sub TextBox1_Change() '调用单元格图片
   
2.     Image1.Picture = LoadPicture("")
   
3.     If TextBox1.Text = "" Then Exit Sub
   
4.     Dim wb As Workbook, c As Range
   
5.     Set c = Sheet1.[a:a].Find(TextBox1.Text, , , xlWhole)
   
6.     If Not c Is Nothing Then
   
7.         Application.ScreenUpdating = False
   
8.         c.Offset(, 1).Select
   
9.         If Dir(ThisWorkbook.Path & "\Book1.htm") <> "" Then Kill ThisWorkbook.Path & "\Book1.htm"
   
10.         ThisWorkbook.PublishObjects.Delete
    
11.         Application.DefaultWebOptions.AllowPNG = False
    
12.         With ThisWorkbook.PublishObjects.Add(xlSourceRange, ThisWorkbook.Path & "\Book1.htm", ActiveSheet.Name, c.Offset(, 1).Address, xlHtmlStatic, "Book1", "")
    
13.             .Publish (True)
    
14.             .AutoRepublish = False
    
15.         End With
    
16.         If Application.Version <= 11 Then '2003
    
17.             Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Book1.files\Book1_image002.jpg")
    
18.         Else '20072010
    
19.             Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Book1.files\Book1_image002.gif")
    
20.         End If
    
21.         Image1.PictureSizeMode = 1
    
22.         Cells(1, 1).Select
    
23.         Application.ScreenUpdating = True
    
24.     End If
    
25. End Sub
    

复制代码

2、Image控件调用工作表批注图片

1. Private Sub TextBox1_Change()
   
2.     Image1.Picture = LoadPicture("")
   
3.     If TextBox1.Text = "" Then Exit Sub
   
4.     Dim wb As Workbook, c As Range, p$
   
5.     Set c = Sheet1.[a:a].Find(TextBox1.Text, , , xlWhole)
   
6.     If Not c Is Nothing Then
   
7.         Application.ScreenUpdating = False
   
8.         Application.DisplayAlerts = False
   
9.         If Dir(ThisWorkbook.Path & "\Book1.htm") <> "" Then Kill ThisWorkbook.Path & "\Book1.htm"
   
10.         p = ThisWorkbook.Path & "\Book1.files"
    
11.         Set wb = Workbooks.Add(xlWBATWorksheet)
    
12.         c.Copy wb.Sheets(1).[a1]
    
13.         wb.SaveAs Filename:=ThisWorkbook.Path & "\Book1.htm", FileFormat:=xlHtml
    
14.         wb.Close False
    
15.         Image1.Picture = LoadPicture(p & Dir(p & "*.jpg"))
    
16.         Image1.PictureSizeMode = 1
    
17.         Application.DisplayAlerts = True
    
18.         Application.ScreenUpdating = True
    
19.     End If
    
20. End Sub
    

复制代码

panan123_0

全对{:soso_e103:}，羡煞旁人。

hzhb14796

知道另存，可是不知道怎么一一对应
Image1.Picture = LoadPicture(p & Dir(p & "*.jpg"))

这样就能一一对应么，困惑了好久

zm0115

请问赵版，3分的答案什么啊

zhaogang1960

hzhb14796 发表于 2011-11-22 17:04
知道另存，可是不知道怎么一一对应
Image1.Picture = LoadPicture(p & Dir(p & "*.jpg"))

已知一个单元格有一个含有1张图片的批注，这个含有批注的单元格复制到新建工作簿中另存为网页，不管有几个图片，只要Dir(p & "*.jpg")<>""就可以了，不需要一一对应

zhaogang1960

zm0115 发表于 2011-11-22 17:11
请问赵版，3分的答案什么啊

本题满分2分，3分需要使用新方法且兼容性好，说实在的，我给出的办法也不能得3分，所以本题我得了1分，哈哈

onthetrip2008

学习了,原来还可以用另存为网页的方法

hzhb14796

zhaogang1960 发表于 2011-11-22 17:18
本题满分2分，3分需要使用新方法且兼容性好，说实在的，我给出的办法也不能得3分，所以本题我得了1分，哈 ...

我说呢，后来想找批注属性或方法直接调用的也没找到

zhaogang1960

hzhb14796 发表于 2011-11-23 08:29
我说呢，后来想找批注属性或方法直接调用的也没找到

谁说的？两种情况都可以使用另存为网页法
下面Image控件调用工作表单元格图片方法，和小结中的Image控件调用工作表批注图片使用的方法一致——另存为网页
请看附件：

hzhb14796

zhaogang1960 发表于 2011-11-23 09:03
谁说的？两种情况都可以使用另存为网页法
下面Image控件调用工作表单元格图片方法，和小结中的Image控件 ...

操作另外的工作薄，我还没有式过，感觉上不好操作