Foxtable(狐表)用户栏目专家坐堂 → Word 报表如何保存为JPG文件


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

主题:Word 报表如何保存为JPG文件

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


加好友 发短信
等级:幼狐 帖子:89 积分:947 威望:0 精华:0 注册:2017/8/7 14:36:00
Word 报表如何保存为JPG文件  发帖心情 Post By:2019/5/15 16:33:00 [只看该作者]



Dim
tm As String  = ProjectPath & "Attachments\出库单.doc" '指定模板文件
Dim
fl As String = ProjectPath & "Reports\出库单.doc" '指定目标文件
Dim
wrt As New WordReport(Tables("出库"),tm,fl) '定义一个WordReport
wrt.Build()
'逐行生成报表
wrt.Show()
'显示报表


SaveImage是不是不能用于WordReport? 应该怎么才可以将Word 报表保存为JPG图片? 

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/5/15 17:45:00 [只看该作者]

参考代码

 

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.Open("d:\test.doc")
    app.ActiveWindow.Selection.WholeStory
    app.ActiveWindow.Selection.copy
    app.ActiveWindow.Selection.PasteSpecial(Link:=False, DataType:=9, _
    Placement:=0, DisplayAsIcon:=False)
    For Each shape As object In doc.InlineShapes
        shape.Range.copy
    Next
    If ClipBoard.GetImage IsNot Nothing Then
        msgbox(2)
        ClipBoard.GetImage.save("d:\abc.jpg")
    End If
    Doc.saved = True
    'app.visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
    app.Quit
End try


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2019/6/27 17:11:00 [只看该作者]

参考

 

Dim app As New MSWord.Application
try
    Dim doc = app.Documents.Open("d:\test.doc")
    Dim allpage = doc.ComputeStatistics(msWord.WdStatistic.wdStatisticPages)
    For objPage As Integer = 1 To allpage
        Dim objWhat = msWord.WdGoToItem.wdGoToPage
        Dim objWhich = MsWord.WdGoToDirection.wdGoToAbsolute
        Dim range1 = Doc.GoTo(objWhat, objWhich, objPage)
        Dim range2 = range1.GoToNext(MsWord.WdGoToItem.wdGoToPage)
        Dim bjStart = range1.Start
        Dim objEnd = range2.Start
        If range1.Start = range2.Start Then objEnd = Doc.Characters.Count
        'msgbox(objpage)
        Doc.Range(bjStart, objEnd).Select
       
        app.ActiveWindow.Selection.copy
        app.ActiveWindow.Selection.PasteSpecial(Link:=False, DataType:=9, _
        Placement:=0, DisplayAsIcon:=False)
    Next
Dim i As Integer = 1
    For Each shape As object In doc.InlineShapes
        shape.Range.copy
        If ClipBoard.GetImage IsNot Nothing Then
            ClipBoard.GetImage.save("d:\abc" & i & ".jpg")
        End If
        i += 1
    Next
    Doc.saved = True
    'app.visible = True
   
   
    app.visible = True
catch ex As exception
    msgbox(ex.message)
    app.Quit
finally
    'app.Quit
End try

 


 回到顶部