如何将doc文件的所有页面转换为单独的图像

时间:2016-08-23 10:56:44

标签: vb.net image ms-word

以下是用于将doc文件转换为image的代码。这适用于只包含一个页面的文件,但如果doc文件中有多个页面,则它只将文件的第一页转换为图像。有人可以建议我如何将所有doc文件转换为单独的图像。

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim objWord As New Microsoft.Office.Interop.Word.Application
        Dim objDoc As Microsoft.Office.Interop.Word.Document
        Const CF_ENHMETAFILE As Integer = 14
        objDoc = objWord.Documents.Open("F:\Study\Constructor.docx")
        objWord.Activedocument.Select()
        objWord.Selection.CopyAsPicture()
        Dim ip As IntPtr
        Dim metaFile As System.Drawing.Imaging.Metafile
        Dim bRet As Boolean
        bRet = ClipboardAPI.OpenClipboard(Me.Handle)
        If bRet = True Then
            'Verify the clipboard contains data available
            'as an enhanced metafile.
            bRet = ClipboardAPI.IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0
        End If

        If bRet = True Then
            'Store the clipboard's contents in the IntPtr.
            ip = ClipboardAPI.GetClipboardData(CF_ENHMETAFILE)
        End If

        'Verify the IntPrt contains data before proceeding. Passing
        'an empty IntPtr to System.Drawing.Imaging.Metafile results
        'in an exception.
        If Not IntPtr.Zero.Equals(ip) Then
            metaFile = New System.Drawing.Imaging.Metafile(ip, True)
            ClipboardAPI.CloseClipboard()
            Dim image As System.Drawing.Image = metaFile
            'Me.PictureBox1.Image = metaFile

            Dim objImageWriter As Image = New Bitmap(image.Width, image.Height)

            Dim objGraphics As Graphics = Graphics.FromImage(objImageWriter)

            objGraphics.Clear(Color.White)
            'objGraphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
            objGraphics.DrawImage(image, 0, 0, image.Width, image.Height)


            image.Dispose()
            objGraphics.Dispose()

            Dim ep As Imaging.EncoderParameters = New Imaging.EncoderParameters
            ep.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 100)

            Dim codecs() As Imaging.ImageCodecInfo = Imaging.ImageCodecInfo.GetImageEncoders()
            Dim iciInfo As Imaging.ImageCodecInfo
            Dim item As Imaging.ImageCodecInfo

            For Each item In codecs
                If (item.MimeType = "image/jpeg") Then iciInfo = item
            Next

            objImageWriter.Save("F:\Study\test1.jpg", iciInfo, ep)
            objImageWriter.Dispose()


        End If


Public Class ClipboardAPI
    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="OpenClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
        Public Shared Function OpenClipboard(ByVal hWnd As IntPtr) As Boolean
    End Function

    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="EmptyClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
    Public Shared Function EmptyClipboard() As Boolean
    End Function

    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="SetClipboardData", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
    Public Shared Function SetClipboardData(ByVal uFormat As Integer, ByVal ByValhWnd As IntPtr) As IntPtr
    End Function

    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="CloseClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
    Public Shared Function CloseClipboard() As Boolean
    End Function

    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="GetClipboardData", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
    Public Shared Function GetClipboardData(ByVal uFormat As Integer) As IntPtr
    End Function

    <Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="IsClipboardFormatAvailable", SetLastError:=True, ExactSpelling:=True, CallingConvention:=System.Runtime.InteropServices.CallingConvention.StdCall)> _
        Public Shared Function IsClipboardFormatAvailable(ByVal uFormat As Integer) As Short
    End Function
End Class

1 个答案:

答案 0 :(得分:1)

问题是该行&#34; objWord.Activedocument.Select()&#34;引用整个文档而不是文档的单个页面。我已经为您的代码添加了一些内容,以捕捉每个页面内容的图像:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim objWord As New Microsoft.Office.Interop.Word.Application
    Dim objDoc As Microsoft.Office.Interop.Word.Document
    Const CF_ENHMETAFILE As Integer = 14
    objDoc = objWord.Documents.Open("F:\Study\Constructor.docx")

    objDoc.Repaginate()
    For i As Integer = 1 To objDoc.ActiveWindow.Panes(1).Pages.Count
        If i = 1 Then
            With objWord.ActiveDocument
                .GoTo(WdGoToItem.wdGoToPage, WdGoToDirection.wdGoToAbsolute, 1)
                .Bookmarks("\Page").Range.Select()
            End With
        Else
            With objWord.Selection
                .GoTo(What:=WdGoToItem.wdGoToPage, Which:=WdGoToDirection.wdGoToNext)
                .Bookmarks("\Page").Range.Select()
            End With
        End If

        objWord.Selection.CopyAsPicture()
        Dim ip As IntPtr
        Dim metaFile As System.Drawing.Imaging.Metafile
        Dim bRet As Boolean
        bRet = ClipboardAPI.OpenClipboard(Me.Handle)
        If bRet = True Then
            'Verify the clipboard contains data available
            'as an enhanced metafile.
            bRet = ClipboardAPI.IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0
        End If

        If bRet = True Then
            'Store the clipboard's contents in the IntPtr.
            ip = ClipboardAPI.GetClipboardData(CF_ENHMETAFILE)
        End If

        'Verify the IntPrt contains data before proceeding. Passing
        'an empty IntPtr to System.Drawing.Imaging.Metafile results
        'in an exception.
        If Not IntPtr.Zero.Equals(ip) Then
            metaFile = New System.Drawing.Imaging.Metafile(ip, True)
            ClipboardAPI.CloseClipboard()
            Dim image As System.Drawing.Image = metaFile
            'Me.PictureBox1.Image = metaFile

            Dim objImageWriter As Image = New Bitmap(image.Width, image.Height)

            Dim objGraphics As Graphics = Graphics.FromImage(objImageWriter)

            objGraphics.Clear(Color.White)
            'objGraphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
            objGraphics.DrawImage(image, 0, 0, image.Width, image.Height)


            image.Dispose()
            objGraphics.Dispose()

            Dim ep As Imaging.EncoderParameters = New Imaging.EncoderParameters
            ep.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 100)

            Dim codecs() As Imaging.ImageCodecInfo = Imaging.ImageCodecInfo.GetImageEncoders()
            Dim iciInfo As Imaging.ImageCodecInfo
            Dim item As Imaging.ImageCodecInfo

            For Each item In codecs
                If (item.MimeType = "image/jpeg") Then iciInfo = item
            Next

            objImageWriter.Save("F:\Study\test" & i.ToString & ".jpg", iciInfo, ep)
            objImageWriter.Dispose()
        End If
    Next
End Sub

其他代码更改摘要:

我添加了#34; objDoc.Repaginate()&#34;获得准确的页面引用。 Word通常不会真正利用页面,它不断查询系统的打印驱动程序,以决定将文本分解为页面的位置。这可以确保我们根据当前机器准确计算页数。

我将你的图像逻辑包含在这个for循环中:&#34; For i As Integer = 1 to objDoc.ActiveWindow.Panes(1).Pages.Count&#34;。紧跟在该行之后的if-else将在第一次迭代中选择第一页,然后选择随后的任何后续页。除了save-filename之外,其他所有内容都保持不变。

最后,由于显而易见的原因,我只是将页码连接到图像的保存路径中......

我在自己的计算机上测试了它,它按预期工作,我希望这有帮助!

...只是一个偏离主题的旁注,我不知道处理Word处理的代码是否包含在你的问题中或者它是否真的丢失了,但是你可能想确保你添加;如果程序已经关闭,Interop类很喜欢在后台运行办公流程,如果它们没有正确处理,这个例子就是让它们在我的计算机上打开。