Excel~代码实现数据区域截图并保存

  Excel 在“插入选项卡”下有个屏幕截图的功能,使用该功能我们可以很方便地对打开的窗口进行快速截图并自动插入到 Excel 工作簿中,但是使用该功能却不能截取 Excel 工作簿中的数据用于保存,很不方便。然而我们在实际使用 Excel 的过程中有时需要记录下每次修改工作簿的内容以备后期查阅,数据截图将会是一个非常快捷有效的方式,以下代码将会帮助你完成此类需求。

Option ExplicitPublic numBeginRows, numBeginColumns, numEndRows, numEndColumns As IntegerFunction UsedRangeParameter() numBeginRows = ActiveSheet.UsedRange.Cells(1, 1).Row '获取当前已用表格区域的初始行位置 numBeginColumns = ActiveSheet.UsedRange.Cells(1, 1).Column '获取当前已用表格区域的初始列位置 numEndRows = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1 '获取当前已用表格区域的末尾行位置 numEndColumns = ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column - 1 '获取当前已用表格区域的末尾列位置End FunctionSub qggScreenshot() On Error Resume Next Dim rngScreenshot As Range, iShape As Shape, picName As String, myFolder As String, selectFolder As String, imgFileFilter As String Call UsedRangeParameter Set rngScreenshot = Range(Cells(numBeginRows, numBeginColumns), Cells(numEndRows, numEndColumns)) picName = "qgg-" & Replace(Replace(rngScreenshot.Address, "$", ""), ":", "") & "-" & Format(Date, "yyyymmdd") 'myFolder = ThisWorkbook.Path & "\Screenshot\" '指定文件夹名称 imgFileFilter = "JPEG 格式图片(*.jpg),*.jpg," & "PNG 格式图片(*.png),*.png," & "BMP 格式文件(*.bmp),*.bmp," & "GIF 格式图片(*.gif),*.gif," selectFolder = Application.GetSaveAsFilename(InitialFileName:=picName, FileFilter:=imgFileFilter, Title:="图片另存为") rngScreenshot.Copy ActiveSheet.Pictures.Paste.Select Selection.ShapeRange.Name = picName '遍历 Shape 元素,找到截图图片 For Each iShape In ActiveSheet.Shapes If iShape.Name = picName Then 'If Len(Dir(myFolder, vbDirectory)) = 0 Then MkDir myFolder iShape.CopyPicture With ActiveSheet.ChartObjects.Add(0, 0, iShape.Width, iShape.Height).Chart .Parent.Select '选择父对象 ChartOjbect ,确保真正的粘贴上 .Paste '.Export myFolder & picName & ".jpg", "JPG" .Export selectFolder .Parent.Delete End With iShape.Delete End If Next iShape If selectFolder <> False Then MsgBox ("数据截图已保存到指定文件夹下!!!")End Sub

代码中自动获取的当前已用数据区域坐标,并可自由选择保存图片格式。

发表评论

评论已关闭。

相关文章