VBA截屏保存

2011-09-11 12:27:47 1.2k 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

避坑指南：HslCommunication连接西门子PLC时常见的5个错误及解决方法（S7-1200/S1500适用）本文详细解析了使用HslCommunication连接西门子S7-1200/S1500 PLC时常见的5个错误及解决方法，包括基础连接配置、数据块读写异常、连接闪断、防火墙与权限问题以及高级调试技巧。通过实战案例和代码示例，帮助开发者快速定位和解决连接问题，提升工业自动化项目的开发效率。阅读详情

VBA中如何实现截屏，再把截屏保存为图片。
有无大虾知道的，帮帮我

...全文

AI医疗影像诊断工具2025 完整教程本教程所述工具均为辅助诊断设备，不可替代执业医师判断。部署使用需遵守当地医疗器械管理法规。推荐开源框架组合：代码太多打包上传网盘了自行下载。2025年的AI医疗影像诊断工具将以。阅读详情

yhlitim

VBA 2,506 成员 10,830 内容

+ 关注 + 加入社区

切换为时间正序

yhlitim 2011-09-11

打赏
举报

运行出错子程序或函数未定义GetDesktopWindow

[Quote=引用 6 楼 veron_04 的回复:]
VB code

Private Sub Command1_Click()
Dim lDesktop As Long
Dim lDC As Long
frmMain.AutoRedraw = True
frmMain.ScaleMode = 1
lDesktop = GetDesktopWindow() '取得桌面窗口
Picture……
[/Quote]

专注编程优化20年 2011-09-11

打赏
举报

SavePicture PictKeyJp(theScreen), "c:\jp.bmp"
这样也可以

专注编程优化20年 2011-09-11

打赏
举报



Private Sub Command1_Click()

Picture1.Picture = LoadPicture("")



Picture1.Picture = KeyJp(theScreen)

SavePicture Picture1.Picture, "c:\jp.bmp"



End Sub

 

Private Sub Command2_Click()

Picture1.Picture = LoadPicture("")

Picture1.Picture = KeyJp(theForm)

SavePicture Picture1.Picture, "c:\jp2.bmp"

End Sub

专注编程优化20年 2011-09-11

打赏
举报



'〓〓〓〓〓〓〓〓〓〓KeyJp函数相关定义声明等 Start

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Enum JpMode

      theScreen = 0 '全屏截图

      theForm = 1 '当前焦点窗口截图

End Enum

'〓〓〓〓〓〓〓〓〓〓KeyJp函数相关定义声明等 End

'┏〓〓〓〓〓〓〓〓〓 KeyJp,start 〓〓〓〓〓〓〓〓〓┓

'［详介］：

'函数注释:

'［简介］：

'按键方式截屏

Function KeyJp(Optional ByVal TheMode As JpMode = theScreen) As IPictureDisp

   'VB源码，帮你写函数，帮你写代码，帮你写模块，帮你设计软件

   '--需要什么函数或功能，可以联系我。

   '版权所有，请保留作者信息.QQ：1085992075

   '如需商业用途请联系作者

      Call keybd_event(vbKeySnapshot, TheMode, 0, 0) '

      DoEvents

      Set KeyJp = Clipboard.GetData(vbCFBitmap)

End Function

'┗〓〓〓〓〓〓〓〓〓  KeyJp,end  〓〓〓〓〓〓〓〓〓┛

yhlitim 2011-09-11

打赏
举报

找到一段代码模拟键盘printscreen，但是用picture输出，VBA中只有image，如果要把图片输出，怎么领用image输出那，这个问题也蛮困扰我的
[Quote=引用 3 楼 yhlitim 的回复:]
图片又如何保存那？
我需要用VBA，VB又该如何调用VBA内

引用 1 楼 veron_04 的回复:
VB截屏
[/Quote]

贝隆 2011-09-11

打赏
举报



Private Sub Command1_Click()

    Dim lDesktop As Long

    Dim lDC As Long

    frmMain.AutoRedraw = True

    frmMain.ScaleMode = 1

    lDesktop = GetDesktopWindow() '取得桌面窗口

    Picture1.AutoRedraw = True

    lDC = GetDC(lDesktop) '取得桌面窗口的设备场景

    BitBlt Picture1.hDC, 0, 0, Screen.Width, Screen.Height, lDC, 0, 0, vbSrcCopy '将桌面图象绘制到窗体

    

    

    SavePicture Picture1.Image, "D:\1.bmp"

End Sub

yhlitim 2011-09-11

打赏
举报

不是这方面高手，开发语言只能是菜鸟级的，我们是搞工程类的
[Quote=引用 4 楼 veron_04 的回复:]
保存图片还不简单？
[/Quote]

贝隆 2011-09-11

打赏
举报

保存图片还不简单？

yhlitim 2011-09-11

打赏
举报

图片又如何保存那？
我需要用VBA，VB又该如何调用VBA内
[Quote=引用 1 楼 veron_04 的回复:]
VB截屏
[/Quote]

yhlitim 2011-09-11

打赏
举报

图片又如何保存那？
我需要用VBA，VB又该如何调用VBA内

贝隆 2011-09-11

打赏
举报

VB截屏

专注编程优化20年 2011-09-11

打赏
举报

完整vba中代码：

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Enum JpMode

      theScreen = 0 '全屏截图

      theForm = 1 '当前焦点窗口截图

End Enum





Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Private Const CF_BITMAP = 2

Private Type PicBmp

    Size As Long

    Type As Long

    hBmp As Long

    hPal As Long

    Reserved As Long

End Type



Private Type Guid

    Data1 As Long

    Data2 As Integer

    Data3 As Integer

    Data4(0 To 7) As Byte

End Type

Function ApiGetClipBmp() As IPicture

On Error Resume Next

    Dim Pic As PicBmp, IID_IDispatch As Guid

    OpenClipboard 0 'OpenClipboard

    With IID_IDispatch

        .Data1 = &H20400

        .Data4(0) = &HC0

        .Data4(7) = &H46

    End With



    With Pic

        .Size = Len(Pic)

        .Type = 1

        .hBmp = GetClipboardData(CF_BITMAP)

    End With

    

    OleCreatePictureIndirect Pic, IID_IDispatch, 1, ApiGetClipBmp

    'stdole.SavePicture ApiGetClipBmp, "c:\clipboard.bmp"

    CloseClipboard

End Function

Function KeyJp(Optional ByVal TheMode As JpMode = theScreen) As IPictureDisp

   '版权所有，请保留作者信息.QQ：1085992075   '如需商业用途请联系作者

      Call keybd_event(vbKeySnapshot, TheMode, 0, 0) '

      DoEvents

      'Set KeyJp = Clipboard.GetData

End Function

'┗〓〓〓〓〓〓〓〓〓  KeyJp,end  〓〓〓〓〓〓〓〓〓┛

Sub dd()

  KeyJp (theScreen)

  SavePicture ApiGetClipBmp, "c:\2.bmp"

End Sub

专注编程优化20年 2011-09-11

打赏
举报

'┏〓〓〓〓〓〓〓〓 ApiGetClipBmp函数相关定义声明等 Start
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const CF_BITMAP = 2
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'┗〓〓〓〓〓〓〓〓 ApiGetClipBmp函数相关定义声明等 End
'┏〓〓〓〓〓〓〓〓〓 ApiGetClipBmp,start 〓〓〓〓〓〓〓〓〓┓
'［简介］：
'API方式获取剪贴板图像，可用于VBA等方式截图保存
Function ApiGetClipBmp() As IPicture
'[mycode_id:2042],edittime:2011-9-11 下午 01:04:32
On Error Resume Next
Dim Pic As PicBmp, IID_IDispatch As Guid
OpenClipboard 0 'OpenClipboard
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = GetClipboardData(CF_BITMAP)
End With

OleCreatePictureIndirect Pic, IID_IDispatch, 1, ApiGetClipBmp
CloseClipboard
End Function
'stdole.SavePicture ApiGetClipBmp, "c:\clipboard.bmp",保存时可用这个方式
'┗〓〓〓〓〓〓〓〓〓 ApiGetClipBmp,end 〓〓〓〓〓〓〓〓〓┛

VBA截屏保存

相关推荐