以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助]提取word表格中的照片后,如何设置保存的照片尺寸  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=157814)

--  作者:slguy0286
--  发布时间:2020/10/30 1:49:00
--  [求助]提取word表格中的照片后,如何设置保存的照片尺寸
Word表格中的照片提取保存后长宽比变化,如何保持为照片原来的尺寸


--  作者:有点蓝
--  发布时间:2020/10/30 8:48:00
--  
怎么提取的?完整代码?
--  作者:slguy0286
--  发布时间: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编辑过]

--  作者:有点蓝
--  发布时间:2020/10/30 9:50:00
--  
这种提取的应该就是原图。如果大小改变说明添加到word后就大小已经改了,和程序无关
--  作者:slguy0286
--  发布时间:2020/10/30 9:52:00
--  

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

原来的照片不是这样

 


--  作者:有点蓝
--  发布时间:2020/10/30 10:00:00
--  
文件发上来看看
--  作者:slguy0286
--  发布时间:2020/10/30 10:43:00
--  
word 文档和生成的图片做为附件上传了
代码是在命令窗口运行的

--  作者:有点蓝
--  发布时间:2020/10/30 10:46:00
--  
上传文件方法:http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&Id=78

另外把完整代码贴出来

--  作者:slguy0286
--  发布时间: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编辑过]

--  作者:有点蓝
--  发布时间:2020/10/30 15:28:00
--  
嗯,我电脑测试也没有问题。

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

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

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