自學VBA——excel截圖保存並規避1004錯誤
背景
本人用excel做了一份數據分析報表，通過在切片器中選定參數，報表可展示出不同的圖表。為了方便圖表間的對比，在報表中設置了截圖按鈕（圖中的照相機）並指定對應的vba宏；通過點擊截圖按鈕，可將報表中的內容以圖片形式保存到新的工作表中；然後使用Ctrl+PageUp/PageDown快捷鍵，就可以在這些工作表之間來回切換，達到類似動圖的效果，從而方便對比不同參數影響下的圖表。
遇到問題
按照原始的截圖代碼，很容易沒截幾張圖，就會彈出運行錯誤警告，令人十分不愉快（儘管退出後重新點擊截圖按鈕，還是可以截圖成功）。
更具體來說：
1、該警告窗口只能通過點擊"結束"按鈕才能退出； 2、如果點擊"調試"按鈕或按下Enter鍵，則會跳轉vba編輯窗口； 3、無法通過Esc或Enter等用戶常用鍵快速退出，必須移動滑鼠點擊"結束"按鈕。如果該報表只是自己用，麻煩點就算了；但如果給導師用，面對不停彈出的錯誤警告.....那我死定了┗|｀O′|┛ 嗷~~
Sub 原始截圖代碼()
Application.CutCopyMode = False
Application.Worksheets("報表").Range("A1:AC36").CopyPicture xlScreen, xlBitmap
Sheets.Add After:=ActiveSheet
ActiveWindow.Zoom = 75
ActiveSheet.Paste
ActiveSheet.Previous.Select
Range("A1").Select
End Sub
問題原因
依照網站上的提示和自己的試錯，發現是電腦在執行前兩行代碼時，往往會反應不過來，也即無法清空剪切板或複製區域圖片，從而使程序報錯。尤其對我那既有數據透視表/圖、切片器，又有各種公式、形狀、圖片的報表，電腦反應不過來是常有的事。
附一個網站上的更專業解釋：
http://www.itdaan.com/blog/2014/07/14/6bed50193bf41277534633675fe764a2.html假設，似乎有理由認為，在緩慢或負載很重的計算機上，Excel會對頁面上的複雜對象進行「延遲處理」，即在以某種方式訪問??對象之前不會對其進行渲染。強制渲染的一種方法似乎是在Visible = 1模式下運行。另一種方法是循環遍歷對象。如果是這種情況，那麼它是Excel的CopyPicture實現的一個錯誤，它不會在嘗試複製之前強制複製對象。當複製方法發現目標範圍的渲染尚未就緒時，它只會拋出錯誤而不是強制渲染範圍。好吧，至少那是我的理論。
解決方案
一切盡在以下的代碼中，效果是基本連續截圖都不會報錯，萬一報錯也可Esc/Enter快速退出重來。各位可直接複製到excel宏模塊中體驗使用。
另注啟發來源：PctGL的發言https://bbs.csdn.net/topics/390865179 找了一下午的，感謝PctGL！！Sub 截圖保存()
程序運行效果：截取當前工作表的某個區域，並在新建工作表中以圖片形式保存（且工作表調整為某縮放比例），然後返回剛被截圖的工作表中。
程序代碼邏輯：一次截圖失敗，那就再截圖一次；如果還是失敗，那就彈窗提示好了（該彈窗可Esc/Enter快速退出）。
【參數設定區】設定當前工作表的截圖區域和所存工作表的縮放比例
PSR = "A1:AC36" PSR = Print Screen Range
SWZ = 75 SWZ = Save Window Zoom
【核心代碼區】
On Error GoTo try_again
Application.CutCopyMode = False
Application.ActiveSheet.Range(PSR).CopyPicture xlScreen, xlBitmap
Sheets.Add After:=ActiveSheet
ActiveWindow.Zoom = SWZ
ActiveSheet.Paste
ActiveSheet.Previous.Select
Exit Sub
try_again:
On Error GoTo -1
On Error GoTo give_up
Application.CutCopyMode = False
Application.ActiveSheet.Range(PSR).CopyPicture xlScreen, xlBitmap
Sheets.Add After:=ActiveSheet
ActiveWindow.Zoom = SWZ
ActiveSheet.Paste
ActiveSheet.Previous.Select
Exit Sub
give_up:
On Error GoTo -1
On Error GoTo give_up
MsgBox "系統繁忙，請重新截屏。"
Exit Sub
End Sub
推薦閱讀：
