将Word中的图片保存为一个文件
2008-11-01 15:49
337 查看
近日被朋友问到如何在Word中把某个插入的图片对象保存为单独的文件。原先他的做法是去调用API,大致的代码是如下面的
.csharpcode, .csharpcode pre
{
font-size: small;
color: black;
font-family: consolas, "Courier New", courier, monospace;
background-color: #ffffff;
/*white-space: pre;*/
}
.csharpcode pre { margin: 0em; }
.csharpcode .rem { color: #008000; }
.csharpcode .kwrd { color: #0000ff; }
.csharpcode .str { color: #006080; }
.csharpcode .op { color: #0000c0; }
.csharpcode .preproc { color: #cc6633; }
.csharpcode .asp { background-color: #ffff00; }
.csharpcode .html { color: #800000; }
.csharpcode .attr { color: #ff0000; }
.csharpcode .alt
{
background-color: #f4f4f4;
width: 100%;
margin: 0em;
}
.csharpcode .lnum { color: #606060; }
这个代码在VB 6.0中确实能工作。但换到Word里面去死活不行。我当时分析猜想就是word那个图片对象所得到的字节可能会不会有些特殊的内容。后来我找到另外一个更加合适的方式解决了
1. 首先添加对ADO的引用
2. 使用下面的代码去保存图片
.csharpcode, .csharpcode pre
{
font-size: small;
color: black;
font-family: consolas, "Courier New", courier, monospace;
background-color: #ffffff;
/*white-space: pre;*/
}
.csharpcode pre { margin: 0em; }
.csharpcode .rem { color: #008000; }
.csharpcode .kwrd { color: #0000ff; }
.csharpcode .str { color: #006080; }
.csharpcode .op { color: #0000c0; }
.csharpcode .preproc { color: #cc6633; }
.csharpcode .asp { background-color: #ffff00; }
.csharpcode .html { color: #800000; }
.csharpcode .attr { color: #ff0000; }
.csharpcode .alt
{
background-color: #f4f4f4;
width: 100%;
margin: 0em;
}
.csharpcode .lnum { color: #606060; }
这里有几个关键点
2.1 使用ADODB.Stream ,其实是一个内存流,这个流里面当然可以放任何东西。
2.2 如何取得Word文档中当前选中的图像对象所包含的字节呢。很好的一个消息是,word中通过Selection.EnhMetaFileBits可以返回
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Type EncoderParameter GUID As GUID NumberOfValues As Long type As Long Value As Long End Type Private Type EncoderParameters count As Long Parameter As EncoderParameter End Type Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long Private Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long Private Sub SavePic(ByVal pict As StdPicture, ByVal FileName As String, PicType As String, _ Optional ByVal Quality As Byte = 80, _ Optional ByVal TIFF_ColorDepth As Long = 24, _ Optional ByVal TIFF_Compression As Long = 6) Screen.MousePointer = vbHourglass Dim tSI As GdiplusStartupInput Dim lRes As Long Dim lGDIP As Long Dim lBitmap As Long Dim aEncParams() As Byte On Error GoTo ErrHandle: tSI.GdiplusVersion = 1 ' 初始化 GDI+ lRes = GdiplusStartup(lGDIP, tSI) If lRes = 0 Then ' 从句柄创建 GDI+ 图像 lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap) If lRes = 0 Then Dim tJpgEncoder As GUID Dim tParams As EncoderParameters '初始化解码器的GUID标识 Select Case PicType Case ".jpg" CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder tParams.count = 1 ' 设置解码器参数 With tParams.Parameter ' Quality CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识 .NumberOfValues = 1 .type = 4 .Value = VarPtr(Quality) End With ReDim aEncParams(1 To Len(tParams)) Call CopyMemory(aEncParams(1), tParams, Len(tParams)) Case ".png" CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder ReDim aEncParams(1 To Len(tParams)) Case ".gif" CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder ReDim aEncParams(1 To Len(tParams)) Case ".tiff" CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder tParams.count = 2 ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter)) With tParams.Parameter .NumberOfValues = 1 .type = 4 CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识 .Value = VarPtr(TIFF_Compression) End With Call CopyMemory(aEncParams(1), tParams, Len(tParams)) With tParams.Parameter .NumberOfValues = 1 .type = 4 CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识 .Value = VarPtr(TIFF_ColorDepth) End With Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter)) Case ".bmp" '可以提前写保存为BMP的代码,因为并没有用GDI+ SavePicture pict, FileName Screen.MousePointer = vbDefault Exit Sub End Select lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像 GdipDisposeImage lBitmap ' 销毁GDI+图像 End If GdiplusShutdown lGDIP '销毁 GDI+ End If Screen.MousePointer = vbDefault Erase aEncParams Exit Sub ErrHandle: Screen.MousePointer = vbDefault MsgBox "在保存图片的过程中发生错误:" & vbCrLf & vbCrLf & "错误号: " & err.Number & vbCrLf & "错误描述: " & err.Description, vbInformation Or vbOKOnly, "错误" End Sub
.csharpcode, .csharpcode pre
{
font-size: small;
color: black;
font-family: consolas, "Courier New", courier, monospace;
background-color: #ffffff;
/*white-space: pre;*/
}
.csharpcode pre { margin: 0em; }
.csharpcode .rem { color: #008000; }
.csharpcode .kwrd { color: #0000ff; }
.csharpcode .str { color: #006080; }
.csharpcode .op { color: #0000c0; }
.csharpcode .preproc { color: #cc6633; }
.csharpcode .asp { background-color: #ffff00; }
.csharpcode .html { color: #800000; }
.csharpcode .attr { color: #ff0000; }
.csharpcode .alt
{
background-color: #f4f4f4;
width: 100%;
margin: 0em;
}
.csharpcode .lnum { color: #606060; }
这个代码在VB 6.0中确实能工作。但换到Word里面去死活不行。我当时分析猜想就是word那个图片对象所得到的字节可能会不会有些特殊的内容。后来我找到另外一个更加合适的方式解决了
1. 首先添加对ADO的引用
2. 使用下面的代码去保存图片
Public Sub SaveImage() Dim ImageStream As Object Set ImageStream = CreateObject("ADODB.Stream") With ImageStream .type = 1 ' adTypeBinary .Open .Write (Selection.EnhMetaFileBits) .SaveToFile ("C:\Test.bmp") .Close End With Set ImageStream = Nothing End Sub
.csharpcode, .csharpcode pre
{
font-size: small;
color: black;
font-family: consolas, "Courier New", courier, monospace;
background-color: #ffffff;
/*white-space: pre;*/
}
.csharpcode pre { margin: 0em; }
.csharpcode .rem { color: #008000; }
.csharpcode .kwrd { color: #0000ff; }
.csharpcode .str { color: #006080; }
.csharpcode .op { color: #0000c0; }
.csharpcode .preproc { color: #cc6633; }
.csharpcode .asp { background-color: #ffff00; }
.csharpcode .html { color: #800000; }
.csharpcode .attr { color: #ff0000; }
.csharpcode .alt
{
background-color: #f4f4f4;
width: 100%;
margin: 0em;
}
.csharpcode .lnum { color: #606060; }
这里有几个关键点
2.1 使用ADODB.Stream ,其实是一个内存流,这个流里面当然可以放任何东西。
2.2 如何取得Word文档中当前选中的图像对象所包含的字节呢。很好的一个消息是,word中通过Selection.EnhMetaFileBits可以返回
相关文章推荐
- 将Word中的图片保存为一个文件
- 将一个NSImage实例保存成图片文件
- 从数据库中读取一个图片并保存为一个图片文件
- 将图片保存到一个XML文件
- 从数据库中读取一个图片并保存为一个图片文件
- 从数据库中读取一个图片并保存为一个图片文件[转]
- 将bitmap对象保存为一个图片文件
- 一个将当前屏幕保存为图片文件的类(简单说就是抓屏)
- 用一个字段保存多个图片或文件路径
- 如何将WEB页面中的数据保存为一个word文件
- 一个将当前屏幕保存为图片文件的类(简单说就是抓屏)
- [Android] 一个将当前屏幕保存为图片文件的类(简单说就是抓屏)
- 批处理图片名字,并保存到一个TXT文件中
- 利用POI抽取word中的图片并保存在文件中
- 将图片保存到一个XML文件
- 怎样一次性将一个word文档中所有图片保存
- 利用POI抽取word中的图片并保存在文件中
- 利用POI抽取word中的图片并保存在文件中
- 将html中的图片和html保存在一个文件里
- 提取WORD中的所有InlineShape图片并保存成文件