Office中国论坛/Access中国论坛

标题: 超难度的批註图片导出 [打印本页]

作者: joyark 时间: 2011-9-30 00:54
标题: 超难度的批註图片导出
本帖最后由 joyark 于 2011-9-30 10:38 编辑

超难度的批註图片导出
謝謝幫忙解決

文件-另存爲-HTML格式，你可以找到所有圖片文件。

作者: tmtony 时间: 2011-9-30 09:35
好像是批注中的背景图。
找小妖来试试？

作者: tmtony 时间: 2011-9-30 10:14
只找到加图片，没有找到导出方法，估计要用API
Sub InsertComment()
Dim cmt As Comment
Set cmt = Range("A20").AddComment
With cmt
.Text Text:=""
.Shape.Fill.UserPicture ("C:\Images\test.jpg")
.Visible = True
End With
End Sub

作者: joyark 时间: 2011-9-30 10:39

tmtony 发表于 2011-9-30 10:14
只找到加图片，没有找到导出方法，估计要用API
Sub InsertComment()
Dim cmt As Comment

可以保存
文件-另存爲-HTML格式，你可以找到所有圖片文件。
謝謝幫忙

作者: 冰心8549 时间: 2011-9-30 11:07
谢谢分享

作者: tmtony 时间: 2011-9-30 11:31

joyark 发表于 2011-9-30 10:39
可以保存
文件-另存爲-HTML格式，你可以找到所有圖片文件。
謝謝幫忙

好办法

作者: yehf 时间: 2011-9-30 13:29
用一个笨方法先解决问题
循环一次每个有图片批注的单元格,将每个单元格复制到一个新的xls文件,然后另存为一个html文件,也就是说,每保存一次,只会有一个图片文件,然后在html的文件夹里面将图片文件改名为单元格的内容.

作者: pureshadow 时间: 2011-9-30 13:43
V白妖飘过~~~~

作者: joyark 时间: 2011-9-30 13:45

yehf 发表于 2011-9-30 13:29
用一个笨方法先解决问题
循环一次每个有图片批注的单元格,将每个单元格复制到一个新的xls文件,然后另存为一 ...

文件-另存爲-HTML格式，你可以找到所有圖片文件。就所有圖片都在

作者: yehf 时间: 2011-9-30 13:49
是所有图片都在,但文件名不是你单元格里面的内容啊

作者: roych 时间: 2011-9-30 21:17

pureshadow 发表于 2011-9-30 13:43
V白妖飘过~~~~

难度也没有大家所想像的那么大，不过也调试了我两小时左右（主要在于没有把默认隐藏的批注显示出来）。
Comment对象的Shape属性有个CopyPicture方法对付的就是joyark这种懒人的（详见附件）。{:soso_e128:}
[attach]46807[/attach]
复制出来的图片属于OLE对象，这里直接粘贴到其它活动单元格了。因此，如果joyark和我较真，非要导出到本地盘路径，或许真要像站长说的那样，要写API函数了（当然，一切需要进一步调试）。{:soso_e135:}

作者: tmtony 时间: 2011-10-1 00:20
PICTURE OLE转文件， API应可实现的。以前有写过 VB的PICTURE 转成文件。网上这方面的内容比较多。
看来程序就是这样，每人想一步。众人拾柴火焰高，每个人都有别人学习的地方。

作者: yehf 时间: 2011-10-10 17:34
由于HTML文件夹生成的image文件存在编号的规律,从001开始,所以可以通过循环单元格对image001进行根据单元格内容改名并移动到桌面
如果有10个批注有图片,其中1张照片重复,那么HTML文件夹里面只会有9张image,001到009,没办法解决
Sub Macro2()
Dim i    As Integer
Dim str As String
Dim oldname As String
Dim newname As String
Dim x    As String
With ThisWorkbook
      For i = 1 To ActiveSheet.UsedRange.Rows.Count
         x = i * 10
         x = IIf(i < 100, Choose(Len(x), "", "00", "0") & i, i) '生成html文件夹的图片命名是顺序是001,002...需要对序号进行转换
         oldname = .Path & "\" & Left(.Name, Len(.Name) - 4) & ".files\image" & x & ".jpg" '测试方便,当前workbook为另存为html的文件,如果直接对xls文件进行操作,需要先另存.
         newname = .Path & "\" & Cells(i, 1) & ".jpg" ''默认当前路径是桌面
         Debug.Print oldname, newname
         Name oldname As newname
      Next
End With
End Sub

作者: 余方方 时间: 2011-12-12 21:27
学习了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)