借助宏实现截图功能

由于给笔记本重装系统，出现这样那样的问题，好几天没更新博客了，最近工作事情还是比较多。呼呼~

写写也没有什么思路。

但在书上看到一则宏代码比较实用。

截图代码！

不需要借助其他软件，只要选择好需要截图的区域，运行代码即可截图，还可以选择格式。不敢独享特分享给大家吧！

上代码：

Sub 将选区转为图片存到桌面()
Dim ans As Byte, Pic As String, Paths As String
On Error Resume Next
Paths = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" ‘记录“桌面”文件夹的路径
star:
‘选择导出图片的格式
ans = Application.InputBox("输入1：保存为GIF图片；" + Chr(10) + "输入2：保存为PNG图片；" + Chr(10) + "输入3：保存为JPG图片。", "图片格式", 1, , , , , 1)
If err <> 0 Then MsgBox "只能输入1到3", 64, "提示": err.Clear: GoTo star ‘如果有误（输入的值在0-255之外）则返回重新输入
If ans < 1 Or ans > 3 Then MsgBox "输入错误": GoTo star ‘如果不等于1、2、3则重新输入
Pic = Choose(ans, ".gif", ".PNG", ".JPG") ‘在三种格式间选择
If TypeName(Selection) = "Range" Then ‘如果选择的对象是单元格
Dim rng As Range
Set rng = Selection ‘将选区赋与变量rng
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture ‘将rng区域复制为图片
ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count + 1).Cells(1).Select ‘选择一个空单元格
With ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height).Chart ‘生成图表
.Paste ‘将图片粘贴到图表中
.Export Paths & Replace(rng.Address(0, 0), ":", "–") & Pic ‘将图表导出为图片文件
.Parent.Delete ‘删除图表对象
End With
rng.Select ‘选择rng对象
End If
Shell "EXPLORER.EXE " & Left(Paths, Len(Paths) – 1), vbMaximizedFocus ‘打开桌面
End Sub

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