Foxtable(狐表)用户栏目专家坐堂 → 如何提取excel中的图片


  共有3887人关注过本帖树形打印复制链接

主题:如何提取excel中的图片

帅哥哟,离线,有人找我吗?
rjh4078
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
如何提取excel中的图片  发帖心情 Post By:2019/6/14 17:41:00 [显示全部帖子]

如题 以前将图纸保存到了excel里 现在想批量取出来 有什么方法

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/14 19:58:00 [显示全部帖子]

谢谢老师  我试了大概10来个文档花费1分钟左右  现在这样的excel文件有4千多个 有没有快一点的方法

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/14 22:48:00 [显示全部帖子]

好  谢谢

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 18:26:00 [显示全部帖子]

老师  现在可以获取部分excel图片 又有新的问题  有部分文档是有密码保护只能只读的 读取的时候需要一个个点 有没有什么方法去掉,还有一个 如果我想获取单元格区间内的图片 要怎么处理
比如获取第4行到第15行之间的

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 19:17:00 [显示全部帖子]

我找到了unprotect的方法 但是有什么办法判断解锁有没有成功呢
因为我们有7 8套密码 我想枚举每个密码 看看哪个是对的

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 19:32:00 [显示全部帖子]

谢谢  我找到了unprotect的方法 但是有什么办法判断解锁有没有成功呢
因为我们有7 8套密码 如何枚举每个密码 看看哪个是对的

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 20:37:00 [显示全部帖子]

没有  运行的时候 第一行代码 就卡住 弹出输入密码的框

Dim file As String=args(0)
Dim r As Row=args(1)
Dim Ifo As new FileInfo(file)
Dim App As New MSExcel.Application

Dim Wb As MSExcel.WorkBook
try
    wb= App.WorkBooks.Open(file,password:="123")
Catch ex As Exception
    wb= App.WorkBooks.Open(file,password:="456")
End try
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
ws.Activate

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 21:47:00 [显示全部帖子]

老大 不行啊  还是弹出要输入密码的提示框  

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 21:52:00 [显示全部帖子]

Dim file As String=args(0)
Dim r As Row=args(1)
Dim Ifo As new FileInfo(file)
Dim App As New MSExcel.Application
App.DisplayAlerts = False
Dim Wb As MSExcel.WorkBook
Dim ok As Boolean = True
Dim psw() As String = {"123","456"}
Dim idx As Integer = 0
Do While ok AndAlso idx < 2
    '' Output.Show(psw(idx))
    try
        wb= App.WorkBooks.Open(file,password:=psw(idx))
        ok = False
    Catch ex As Exception
        idx += 1
        app.quit
    End try
Loop
If ok = False
    Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
    ws.Activate
    Dim Rg As MSExcel.Range = Ws.UsedRange
    For j As Integer=0 To rg.count
        If j<29 Then
            Dim na As String
            na=Ifo.Name.Replace(Ifo.Extension,"")
            Dim i As Integer=0
            For Each s As object In rg.shapes
                s.CopyPicture(Appearance:=1, Format:=2)
                ClipBoard.GetImage.save(r("保存路径") & "\" & na & "-" & i & ".jpg")
                i=i+1
            Next
            Dim nr As Row=Tables("扫描记录").addnew
            nr("文件名")=Ifo.name
            nr("扫描时间")=Date.now
            nr("图片数量")=i
            nr.save
            app.quit
        End If
    Next
End If

这个是异步函数


调用代码
Dim r As Row=Tables("excel图片提取").current
If r.Isnull("扫描路径") OrElse r.Isnull("保存路径") Then
    MessageBox.show("请先设置扫描和保存路径!","提示")
    Return
End If
If FileSys.DirectoryExists(r("扫描路径")) =False
    MessageBox.show("扫描路径不存在!","提示")
    Return
End If
If FileSys.DirectoryExists(r("保存路径")) =False
    MessageBox.show("保存路径不存在!","提示")
    Return
End If
For Each file As String In filesys .GetFiles(r("扫描路径"))
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Functions.AsyncExecute(Functions.Execute("scan",file,r))
    End If
Next

 回到顶部
帅哥哟,离线,有人找我吗?
rjh4078
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:狐精 帖子:3361 积分:24808 威望:0 精华:0 注册:2012/3/26 21:47:00
  发帖心情 Post By:2019/6/17 21:53:00 [显示全部帖子]

现在提示 shapes 不是rg的成员 还有继续弹出密码输入框

 回到顶部
总数 23 1 2 3 下一页