利用VBA選定Excel儲存格截圖

很久以前找了一支截圖的程式
可以針對Excel的儲存格範圍(例如A1:AD47)來做截圖
並且放在指定的資料夾下

簡單修改了一下



Sub 截圖()

Dim i, j As Integer
Dim rng As Range
Dim shp As Shape
Dim nm$, myFolder$, pictureFullName$, pictureName$

myFolder = "C:\Users\ASUS\Desktop\" & Format(Now, "yyyymmdd") & "\" '資料夾路徑(要改)
Set rng = Range("A1:AD47") '截圖範圍(要改)
rng.Copy

ActiveSheet.Pictures.Paste

For Each shp In ActiveSheet.Shapes
    If shp.Type = 13 Then   'msoPicture
        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
            MkDir myFolder
        End If
        pictureName = "test3" '(要改)
        pictureFullName = pictureName & ".jpg"
        shp.CopyPicture
     
        With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
            .Parent.Select
            .Paste
            .Export myFolder & pictureFullName, "JPG"
            .Parent.Delete
        End With
     
        shp.Delete
     
    End If
Next

End Sub

要修改的部分也已經註記上去
分享給有需要的朋友~