网站首页
手机版

word右键怎么增加图片另存为(word右键怎么增加图片另存为文件)

更新时间:2023-03-11 00:18:32作者:佚名

word右键怎么增加图片另存为(word右键怎么增加图片另存为文件)

如果我们想把word中的图片保存下来,苦恼word无法使用右键图片另存为,接下来小编就为大家介绍一下如何使用VBA代码增加图片另存为
word右键怎么增加图片另存为
代码如下:

Option Explicit

Private Const UnitPixel As Long = 2
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Enum EncoderParameterValueType
EncoderParameterValueTypeByte = 1
EncoderParameterValueTypeASCII = 2
EncoderParameterValueTypeShort = 3
EncoderParameterValueTypeLong = 4
EncoderParameterValueTypeRational = 5
EncoderParameterValueTypeLongRange = 6
EncoderParameterValueTypeUndefined = 7
EncoderParameterValueTypeRationalRange = 8
End Enum

Private Type EncoderParameter
GUID(0 To 3) As Long
NumberOfValues As Long
Type As EncoderParameterValueType
Value As Long
End Type

Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type

Private Type ImageCodecInfo
ClassID(0 To 3) As Long
FormatID(0 To 3) As Long
CodecName As Long
DllName As Long
FormatDescription As Long
FilenameExtension As Long
MimeType As Long
Flags As Long
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal hImage As Long, ByVal sFilename As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image 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 GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, Size As Long) As Long
Private Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal Size As Long, Encoders As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszProgID As Long, pCLSID As Any) As Long
Private Declare Function GdipBitmapSetResolution Lib "gdiplus" (ByVal Bitmap As Long, ByVal xdpi As Single, ByVal ydpi As Single) As Long

Public Enum ImageFileFormat
Bmp = 1
Jpg = 2
Png = 3
Gif = 4
End Enum

Public Function SaveStdPicToFile(Stdpic As StdPicture, ByVal FileName As String, _
Optional ByVal FileFormat As ImageFileFormat = Jpg, _
Optional ByVal JpgQuality As Long = 80, _
Optional Resolution As Single) As Boolean

Dim CLSID(3) As Long
Dim Bitmap As Long
Dim Token As Long
Dim Gsp As GdiplusStartupInput

Gsp.GdiplusVersion = 1 'GDI+ 1.0版本
GdiplusStartup Token, Gsp '初始化GDI+
GdipCreateBitmapFromHBITMAP Stdpic.Handle, Stdpic.hPal, Bitmap
If Bitmap <> 0 Then '说明我们成功的将StdPic对象转换为GDI+的Bitmap对象了
GdipBitmapSetResolution Bitmap, Resolution, Resolution
Select Case FileFormat
Case ImageFileFormat.Bmp
If Not GetEncoderClsID("Image/bmp", CLSID) = -1 Then
SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
End If
Case ImageFileFormat.Jpg 'JPG格式可以设置保存的质量
Dim aEncParams() As Byte
Dim uEncParams As EncoderParameters
If GetEncoderClsID("Image/jpeg", CLSID) <> -1 Then
uEncParams.Count = 1 ' 设置自定义的编码参数,这里为1个参数
If JpgQuality < 0 Then
JpgQuality = 0
ElseIf JpgQuality > 100 Then
JpgQuality = 100
End If
ReDim aEncParams(1 To Len(uEncParams))
With uEncParams.Parameter
.NumberOfValues = 1
.Type = EncoderParameterValueTypeLong ' 设置参数值的数据类型为长整型
Call CLSIDFromString(StrPtr(EncoderQuality), .GUID(0))' 设置参数唯一标志的GUID,这里为编码品质
.Value = VarPtr(JpgQuality) ' 设置参数的值:品质等级,最高为100,图像文件大小与品质成正比
End With
CopyMemory aEncParams(1), uEncParams, Len(uEncParams)
SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), aEncParams(1)) = 0)
End If
Case ImageFileFormat.Png
If Not GetEncoderClsID("Image/png", CLSID) = -1 Then
SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
End If
Case ImageFileFormat.Gif
If Not GetEncoderClsID("Image/gif", CLSID) = -1 Then '如果原始的图像是24位,则这个函数会调用系统的调色板来将图像转换为8位,转换的效果会不尽人意,但也有可能系统不自动转换,保存失败
SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
End If
End Select
End If
GdipDisposeImage Bitmap '注意释放资源
GdiplusShutdown Token '关闭GDI+。
End Function

Private Function GetEncoderClsID(strMimeType As String, ClassID() As Long) As Long
Dim Num As Long
Dim Size As Long
Dim I As Long
Dim Info() As ImageCodecInfo
Dim Buffer() As Byte
GetEncoderClsID = -1
GdipGetImageEncodersSize Num, Size '得到解码器数组的大小
If Size <> 0 Then
ReDim Info(1 To Num) As ImageCodecInfo '给数组动态分配内存
ReDim Buffer(1 To Size) As Byte
GdipGetImageEncoders Num, Size, Buffer(1) '得到数组和字符数据
CopyMemory Info(1), Buffer(1), (Len(Info(1)) * Num) '复制类头
For I = 1 To Num '循环检测所有解码
If (StrComp(PtrToStrW(Info(I).MimeType), strMimeType, vbTextCompare) = 0) Then '必须把指针转换成可用的字符
CopyMemory ClassID(0), Info(I).ClassID(0), 16'保存类的ID
GetEncoderClsID = I '返回成功的索引值
Exit For
End If
Next
End If
End Function

Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim Out As String
Dim Length As Long
Length = lstrlenW(lpsz)
If Length > 0 Then
Out = StrConv(String$(Length, vbNullChar), vbUnicode)
CopyMemory ByVal Out, ByVal lpsz, Length * 2
PtrToStrW = StrConv(Out, vbFromUnicode)
End If
End Function

For Each cbn In Array("AutoText", "Drawing Canvas", "Organization Chart", "Diagram", "Frames", "Flowchart", "Inline Picture", "Floating Picture", "Shapes", "Inline Canvas", "Table Pictures", "AutoShapes", "Basic Shapes", "Insert Shape", "Picture", "WordArt Context Menu", "WordArt")

本文标签: 参数  数组  另存为  

为您推荐

WPS2016文档怎么快速转换成PDF(wps office文档转换)

WPS2016文档怎么快速转换成PDF 1.打开需要转成的WPS文档,然后点击工具栏的"输出为PDF" 2.接着我们就可以选择转换的页面以及勾选相关的选项. 3

2023-09-28 00:08

手机WPS 手机wps表格怎么制作表格

手机WPS Office怎么填充表格? 手机WPS Office怎么填充表格? 1.首先打开手机WPS Office 2.打开或新建表格 3.点击"工具" 4.

2023-09-27 00:11

WPS2016打印如何节省纸张(wpsoffice怎么打印一张纸)

WPS2016打印如何节省纸张 首先我们在制作文档的时候为了区分段落经常会给段落加上空格进行区分,其实我们可以删除这个段落,这样对于长篇的文档来说可以节省很多空

2023-09-27 00:11

WPS2016如何限制文档编辑 wps文档怎么限制编辑

WPS2016如何限制文档编辑 1.打开需要限制编辑的文档,然后点击左上角的"WPS文字"然后点击"工具"→"限制编辑" 2.在限制编辑列表里点击"限制"选项,

2023-09-27 00:11

WPS2016个性页眉如何制作(wps做页眉)

WPS2016个性页眉如何制作 1.打开需要插入个性页眉的WPS文档 2.点击工具栏的"插入",点击"页眉和页脚" 3.接着点击"插入"→"形状",我们就可以在

2023-09-27 00:10

WPS2016如何修改纸张大小(wps怎样更改纸张大小)

WPS2016如何修改纸张大小 1.打开WPS文档,然后点击工具栏的"页面布局",接着选择"纸张大小" 2.进入页面设置选项后我们就可以根据自己的需求修改页面纸

2023-09-27 00:10