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

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

Option Explicit

Public numBeginRows, numBeginColumns, numEndRows, numEndColumns As Integer

Function 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 Function

Sub 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

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