借助宏实现截图功能

截图
由于给笔记本重装系统,出现这样那样的问题,好几天没更新博客了,最近工作事情还是比较多。呼呼~
写写也没有什么思路。
但在书上看到一则代码比较实用。
截图代码!
不需要借助其他软件,只要选择好需要截图的区域,运行代码即可截图,还可以选择格式。不敢独享特分享给大家吧!
上代码:
 
  1. Sub 将选区转为图片存到桌面()   
  2.   Dim ans As Byte, Pic As String, Paths As String   
  3.  On Error Resume Next   
  4.   Paths = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" ‘记录“桌面”文件夹的路径  
  5. star:  
  6.   ‘选择导出图片的格式  
  7.   ans = Application.InputBox("输入1:保存为GIF图片;" + Chr(10) + "输入2:保存为PNG图片;" + Chr(10) + "输入3:保存为JPG图片。", "图片格式", 1, , , , , 1)  
  8.   If err <> 0 Then MsgBox "只能输入13", 64, "提示": err.Clear: GoTo star ‘如果有误(输入的值在0-255之外)则返回重新输入  
  9.   If ans < 1 Or ans > 3 Then MsgBox "输入错误": GoTo star ‘如果不等于1、2、3则重新输入  
  10.   Pic = Choose(ans, ".gif", ".PNG", ".JPG") ‘在三种格式间选择  
  11.   If TypeName(Selection) = "Range" Then ‘如果选择的对象是单元格  
  12.     Dim rng As Range  
  13.     Set rng = Selection ‘将选区赋与变量rng  
  14.     rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture ‘将rng区域复制为图片  
  15.     ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count + 1).Cells(1).Select ‘选择一个空单元格  
  16.     With ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height).Chart ‘生成图表  
  17.       .Paste  ‘将图片粘贴到图表中  
  18.       .Export Paths & Replace(rng.Address(0, 0), ":", "") & Pic ‘将图表导出为图片文件  
  19.       .Parent.Delete ‘删除图表对象  
  20.     End With  
  21.     rng.Select ‘选择rng对象  
  22.   End If  
  23.   Shell "EXPLORER.EXE " & Left(Paths, Len(Paths) – 1), vbMaximizedFocus ‘打开桌面   
  24. End Sub   

   把这个指定到控件按钮上执行则更好~

分享到: