Foxtable(狐表)用户栏目专家坐堂 → [求助]提取word表格中的照片后,如何设置保存的照片尺寸


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

主题:[求助]提取word表格中的照片后,如何设置保存的照片尺寸

美女呀,离线,留言给我吧!
slguy0286
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:26 积分:620 威望:0 精华:0 注册:2017/4/12 14:29:00
[求助]提取word表格中的照片后,如何设置保存的照片尺寸  发帖心情 Post By:2020/10/30 1:49:00 [只看该作者]

Word表格中的照片提取保存后长宽比变化,如何保持为照片原来的尺寸


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


加好友 发短信
等级:超级版主 帖子:110810 积分:563988 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/10/30 8:48:00 [只看该作者]

怎么提取的?完整代码?

 回到顶部
美女呀,离线,留言给我吧!
slguy0286
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:26 积分:620 威望:0 精华:0 注册:2017/4/12 14:29:00
  发帖心情 Post By:2020/10/30 9:47:00 [只看该作者]

app.ActiveWindow.Selection.WholeStory
        For Each shape As object In app.ActiveWindow.Selection.InlineShapes
            If shape.Type = MSWord.WdInlineShapeType.wdInlineShapePicture
                Dim img As Byte() = shape.Range.EnhMetaFileBits
                Dim bmp As new Bitmap(new IO.MemoryStream(img))
                bmp.Save(ProjectPath & "Attachments/" & fdr("姓名") & ".jpg")
            End If
        Next

              fdr("照片") = fdr("姓名") & ".jpg"

 

提取之后照片尺寸变成577*194,并且横向不足的部分自动用白色背景补足

[此贴子已经被作者于2020/10/30 9:50:48编辑过]

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


加好友 发短信
等级:超级版主 帖子:110810 积分:563988 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/10/30 9:50:00 [只看该作者]

这种提取的应该就是原图。如果大小改变说明添加到word后就大小已经改了,和程序无关

 回到顶部
美女呀,离线,留言给我吧!
slguy0286
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:26 积分:620 威望:0 精华:0 注册:2017/4/12 14:29:00
  发帖心情 Post By:2020/10/30 9:52:00 [只看该作者]

提取之后照片尺寸变成577*194,并且横向不足的部分自动用白色背景补足

原来的照片不是这样

 


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


加好友 发短信
等级:超级版主 帖子:110810 积分:563988 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/10/30 10:00:00 [只看该作者]

文件发上来看看

 回到顶部
美女呀,离线,留言给我吧!
slguy0286
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:26 积分:620 威望:0 精华:0 注册:2017/4/12 14:29:00
  发帖心情 Post By:2020/10/30 10:43:00 [只看该作者]

word 文档和生成的图片做为附件上传了
代码是在命令窗口运行的

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


加好友 发短信
等级:超级版主 帖子:110810 积分:563988 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/10/30 10:46:00 [只看该作者]

上传文件方法:http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&Id=78

另外把完整代码贴出来

 回到顶部
美女呀,离线,留言给我吧!
slguy0286
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:婴狐 帖子:26 积分:620 威望:0 精华:0 注册:2017/4/12 14:29:00
  发帖心情 Post By:2020/10/30 15:12:00 [只看该作者]

word文档范例和代码生成的图片

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:a.zip

 

换了一台机器就没有这个问题

改一下

 

Dim app As New MSWord.Application
try
    Dim fileName = "d:\a.doc"
    Dim doc = app.Documents.Open(fileName)
   
    For Each shape As object In doc.InlineShapes
        If shape.Type = MSWord.WdInlineShapeType.wdInlineShapePicture
           
            Dim img As Byte() = shape.Range.EnhMetaFileBits
            Dim bmp As new Bitmap(new IO.MemoryStream(img))
            bmp.Save("d:\aaa.jpg")
        End If
    Next
    For Each shape As object In doc.Shapes
       
        msgbox(shape.Type)
        If shape.Type = 13
            shape = shape.ConvertToInlineShape
            Dim img As Byte() = shape.Range.EnhMetaFileBits
            Dim bmp As new Bitmap(new IO.MemoryStream(img))
            bmp.Save("d:\aaa.jpg")
        End If
    Next
    doc.saved = true
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try


[此贴子已经被作者于2020/10/30 15:12:41编辑过]

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


加好友 发短信
等级:超级版主 帖子:110810 积分:563988 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/10/30 15:28:00 [只看该作者]

嗯,我电脑测试也没有问题。

这2台电脑安装的office版本是否一样?有没有安装wps?

试试下载安装下面的数据访问组件:

http://www.foxtable.com/download/AccessDatabaseEngine.exe


 回到顶部
总数 11 1 2 下一页