截屏后保存为图片的VBA语句

wcymiss

yf_home 发表于 2015-4-1 21:04
有没有办法解决？

如果事先知道是复制单元格区域的话，可以将剪贴板里颜色数据导出后更改边框颜色再保存为文件。

yf_home

wcymiss 发表于 2015-4-3 14:10
如果事先知道是复制单元格区域的话，可以将剪贴板里颜色数据导出后更改边框颜色再保存为文件。

刚刚试了一下，Excel本身自带的粘贴为图片，不会有缺少边框的效果。

wcymiss

yf_home 发表于 2015-4-3 14:21
刚刚试了一下，Excel本身自带的粘贴为图片，不会有缺少边框的效果。

嗯，发现excel自带粘贴的是metafile格式的图片。不过这个效果会在右边和下边多出空白边。。

将3楼代码修改如下（红色部分是修改的地方）：

'剪贴板函数
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal Format As Long) As Long

'OLE函数
Private Type Clsid
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Clsid) As Long

'GDI函数
Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
   Guid As Clsid
   NumberOfValues As Long
   type As Long
   value As Long
End Type

Private Type EncoderParameters
   count As Long
   Parameter As EncoderParameter
End Type

Private Const CLSID_JPG As String = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"

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 GdipCreateMetafileFromEmf Lib "gdiplus" (ByVal hEmf As Long, ByVal deleteEmf As Boolean, metafile 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 Clsid, encoderParams As Any) As Long

Sub ClipboardMetafileToJPGFile() '剪贴板中metafile格式图片保存为JPG文件
    Dim hMem As Long
    Dim metafile As Long
    Dim GDI_Token As Long
    Dim GpInput As GdiplusStartupInput
    Dim ReturnValue As Long
    Dim Params As EncoderParameters
    Dim Quality As Long
   
    '获取剪贴板BMP数据的Handle
    OpenClipboard 0&
    hMem = GetClipboardData(14) '获取hemf
    CloseClipboard
    If hMem = 0 Then MsgBox "未找到剪贴板中metafile格式数据": Exit Sub
   
    '初始化GDI+
    GpInput.GdiplusVersion = 1
    ReturnValue = GdiplusStartup(GDI_Token, GpInput)
    If ReturnValue <> 0 Then MsgBox "初始化GDI+失败！": Exit Sub
   
   '创建GDI+的metafile对象
    GdipCreateMetafileFromEmf hMem, False, metafile
   
    'JPG压缩参数设置
    Quality = 50
    With Params
        .count = 1
        With .Parameter
            .Guid = GetEncoderClsid(EncoderQuality)
            .NumberOfValues = 1
            .type = 4
            .value = VarPtr(Quality)
        End With
    End With
    GdipSaveImageToFile metafile, StrPtr("D:\Test\2.jpg"), GetEncoderClsid(CLSID_JPG), Params
   
    GdipDisposeImage metafile
    GdiplusShutdown GDI_Token
End Sub

Private Function GetEncoderClsid(CLSIDString As String) As Clsid
    CLSIDFromString StrPtr(CLSIDString), GetEncoderClsid
End Function

yf_home

wcymiss 发表于 2015-4-6 19:21
嗯，发现excel自带粘贴的是metafile格式的图片。不过这个效果会在右边和下边多出空白边。。

将3楼代 ...

测试了一下，13楼代码确实弥补了左边与上边缺少边框的异常。
但也正如你所说，右边和下边的边框确实是粗了一些，不过应该没关系了。

想问一下吴姐，只能保存为JPG图片格式吗？
如果可以在保存对话框选项中，自定义格式就最好了。
比如：png,GIF,bmp,TIF,JPG,JPEG ..... 等等.

.

wcymiss

yf_home 发表于 2015-4-7 07:57
测试了一下，13楼代码确实弥补了左边与上边缺少边框的异常。
但也正如你所说，右边和下边的边框确实是粗 ...

楼主要求的是jpg，所以我只写了jpg图片的保存。事实上，BMP、GIF、PNG图片的保存比JGP要简单，TIFF格式要复杂些。

yf_home

wcymiss 发表于 2015-4-7 11:49
楼主要求的是jpg，所以我只写了jpg图片的保存。事实上，BMP、GIF、PNG图片的保存比JGP要简单，TIFF格式 ...

有空的时候能否增加上BMP、GIF、PNG图片的保存格式，谢谢！

.

yf_home

wcymiss 发表于 2015-4-7 11:49
楼主要求的是jpg，所以我只写了jpg图片的保存。事实上，BMP、GIF、PNG图片的保存比JGP要简单，TIFF格式 ...

再把路径与名称灵活性，就可以做成一个标准型的加载宏了。

.

wcymiss

yf_home 发表于 2015-4-7 12:35
有空的时候能否增加上BMP、GIF、PNG图片的保存格式，谢谢！

.

网上有现成的代码：
http://home.eeworld.com.cn/my/space-uid-256707-blogid-38411.html

请注意：
1、并不是每次复制图片后，剪贴板内都有metafile格式的图片数据的。（比如按PrScrn键截屏后剪贴板就没有metafile数据。）要根据剪贴板现有的数据选取其中一种图片格式进行保存。（bmp格式一般都会有）

2、jpeg格式和tiff格式在保存的时候，涉及到各种参数的选择，比如jpeg格式涉及质量、亮度、色度等等，tiff格式涉及色深、压缩、保存等参数。在保存时，可选择只设置一个参数，也可设置多个参数。上面链接的代码中jpeg格式设置了一个质量参数，tiff格式设置了色深压缩两个参数。

3、jpg、jpeg是同一种格式图片，仅仅是扩展名不同。

刘雄军

我的要求简单些，就是把整个屏幕截图，导出为D:\2.jpg即可。
截图的语言我已经写好了，就差导出的语言了。

sam.tan

收藏，好好学习学习......