天天笑 发表于 2014-3-26 15:58:40

Excel如何提取单元格中的图片到文件夹并用相应的单元格命名图片[已解决]

本帖最后由 天天笑 于 2014-3-28 08:41 编辑

Excel如何提取单元格中的图片到文件夹并用相应的单元格命名图片；
例如：在单元格A1里面有一幅图，提取出来之后放到D:\Temp\A1-1.jpg
         在单元格A2里面有两幅图，提取出来之后放到D:\Temp\A2-1.jpg、A2-2.jpg
         在单元格A3里面有三幅图，提取出来之后放到D:\Temp\A3-1.jpg、A3-2.jpg、A3-3.jpg


先谢谢各位了

kevinch 发表于 2014-3-26 16:00:12

给个测试文件呗

天天笑 发表于 2014-3-26 16:14:29

本帖最后由 天天笑 于 2014-3-26 16:18 编辑

Hi kevinch,
测试附件~

kevinch 发表于 2014-3-26 18:07:41

#include <ScreenCapture.au3>
#include <ClipBoard.au3>

$dic=ObjCreate("scripting.dictionary")
If Not IsObj($dic) Then
        MsgBox(0,"错误","创建对象失败！")
        Exit 0
EndIf
$xls=ObjGet(@ScriptDir&"\Test.xlsx")
If IsObj($xls) Then
        _GDIPlus_Startup()
        For $pic In $xls.activesheet.shapes
                $pic.copy
                If $dic.exists($pic.topleftcell.address(0,0)) Then
                        $dic($pic.topleftcell.address(0,0))=$dic($pic.topleftcell.address(0,0))+1
                Else
                        $dic($pic.topleftcell.address(0,0))=1
                EndIf
                $picname=$pic.topleftcell.address(0,0)&"-"&$dic($pic.topleftcell.address(0,0))&".jpg"
                _ClipBoard_Open(0)
                $iVerifyPics = _ClipBoard_GetDataEx($CF_BITMAP)
                $iVerifyPics = _GDIPlus_BitmapCreateFromHBITMAP($iVerifyPics)
                _GDIPlus_ImageSaveToFile ($iVerifyPics, @ScriptDir&"\"&$picname)
                _ClipBoard_Close()
        Next
        $xls.close(false)
EndIf这个试一下，本打算用excel自身的方法提取，无奈在au3中水土不服

以上代码参考了坛友的代码，链接如下：
http://www.autoitx.com/forum.php?mod=viewthread&tid=36959

天天笑 发表于 2014-3-27 11:46:28

本帖最后由 天天笑 于 2014-3-27 11:53 编辑

Hi kevinch，
经测试是可以用的。

不过还要两个地方需要请教一下的
1.获取到的图片的像素能否保持原来的像素呢；
2.如果合并了单元格，就只要第一个单元格来命名就可以了；比如1：A1、A2、A3合并了单元格，有三个图片在这个合并单元格里面，就命名为：A1-1，A1-2，A1-3；比如2：A1、B1、C1合并了单元格，有三个图片在这个合并单元格里面，就命名为：A1-1，A1-2，A1-3

damoo 发表于 2014-3-27 16:25:10

这个很实用。收藏一下。

kevinch 发表于 2014-3-27 20:05:19

#include <ScreenCapture.au3>
#include <ClipBoard.au3>

$dic=ObjCreate("scripting.dictionary")
If Not IsObj($dic) Then
        MsgBox(0,"错误","创建对象失败！")
        Exit 0
EndIf
$xls=ObjGet(@ScriptDir&"\Test.xlsx")
If IsObj($xls) Then
        _GDIPlus_Startup()
        For $pic In $xls.activesheet.shapes
                $pic.copy
                If $dic.exists($pic.topleftcell.mergearea(1).address(0,0)) Then
                        $dic($pic.topleftcell.mergearea(1).address(0,0))=$dic($pic.topleftcell.mergearea(1).address(0,0))+1
                Else
                        $dic($pic.topleftcell.mergearea(1).address(0,0))=1
                EndIf
                $picname=$pic.topleftcell.mergearea(1).address(0,0)&"-"&$dic($pic.topleftcell.mergearea(1).address(0,0))&".jpg"
                _ClipBoard_Open(0)
                $iVerifyPics = _ClipBoard_GetDataEx($CF_BITMAP)
                $iVerifyPics = _GDIPlus_BitmapCreateFromHBITMAP($iVerifyPics)
                _GDIPlus_ImageSaveToFile ($iVerifyPics, @ScriptDir&"\"&$picname)
                _ClipBoard_Close()
        Next
        $xls.close(false)
EndIf命名的这样就行了，像素的，因为未见到有被缩放的图片，提取的都是100%显示的，似乎一保存就压缩了

天天笑 发表于 2014-3-28 08:35:44

本帖最后由 天天笑 于 2014-3-28 08:38 编辑

感谢kevinch的帮忙 ，测试可用！
页: [1]
查看完整版本: Excel如何提取单元格中的图片到文件夹并用相应的单元格命名图片[已解决]