Excel表格区域截图保存到E盘

Private Sub CommandButton1_Click()
Dim Myn1, Myn2
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕刷新
'If Dir("E:\课表数据", vbDirectory) = "" Then MkDir "E:\课表数据"
'If Dir("E:\课表数据\新建大课表", vbDirectory) = "" Then MkDir "E:\课表数据\新建大课表"
With Sheets(3)
' Myn1 = [b2].Value
' Myn2 = [l27].Value
' With [b2:aq11].CopyPicture
' .Copy
' End With


[b2:aq11].CopyPicture
ActiveSheet.Pictures.Paste.Select
With Selection
.ShapeRange.IncrementRotation 90
.Copy
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Height, Selection.Width).Chart
.Parent.Select '版本不同有出入,低级版本删除
.Paste
fnm = ThisWorkbook.Path & "\导出区域图片.jpg"
.Export fnm
.Parent.Delete
End With
.Delete
End With

' Set Shp1 = ActiveSheet.Pictures.Paste
' Shp1.Copy
' With Sheet3.ChartObjects.Add(0, 0, Shp1.Width, Shp1.Height).Chart
' .Paste
' .Export "E:\课表数据\新建大课表\" & Myn1 & ".jpg" '截图在E盘
' .Parent.Delete
' End With
' Shp1.Delete
' With [l27:ag37]
' .Copy
' End With
' Set Shp2 = ActiveSheet.Pictures.Paste
' Shp2.Copy
' With Sheet3.ChartObjects.Add(0, 0, Shp2.Width, Shp2.Height).Chart
' .Paste
' .Export "E:\课表数据\新建大课表\" & Myn2 & ".jpg" '截图在E盘
' .Parent.Delete
' End With
' Shp2.Delete
End With
Application.ScreenUpdating = True '开启屏幕刷新
End Sub

 

posted @ 2022-11-17 20:16  依云科技  阅读(311)  评论(0)    收藏  举报