如何在Excel中用VBA批量生成“照相机“图片

左手的ㄟ右手 2022-11-22 00:04 236阅读 0赞

什么?你不知道照相机是什么??那参见我这篇文章吧

> [Excel做数据海报][Excel]

# 需求描述 #

目前的状况是这样的,我有1个总表,26个子表.26个子表是按照总表的某个字段拆分出来的.然后我需要生成26个子表的照相机图片  
![在这里插入图片描述][20201103191918969.png_pic_center]

# VBA #

Private Sub pictureSheet()    
        Dim Sht As Worksheet
        Dim iSht As Worksheet
        Dim iCnt%,eRow%,eCol%
        
        IMG_NAME = "img"    '用于存放图片的工作表
        iCnt = 1            '图片编号.不需要图片名称的可以忽略
        
        Set iSht = ActiveWorkbook.Sheets(IMG_NAME)
        
        For Each Sht In ActiveWorkbook.Sheets
            If Sht.Name <> "总表" And Sht.Name <> "base" And Sht.Name <> "img" Then '这里排除不需要生成图片的表名
                If Sht.Visible = xlSheetVisible Then    '这里是防止报错中断的时候,接着前面的图继续生成而做的措施
                    With Sht
                        eCol = .Cells(2,.Columns.Count).End(xlToLeft).Column
                        eRow = .Cells(.Rows.Count,1).End(3).Row
                        .Activate
                        Application.Wait Now + TimeValue("00:00:01")        '因为调用剪切板的时候Excel经常会报错,故需休眠1秒,下面两处同理
                        .Range(.Cells(1,1),.Cells(eRow,eCol)).CopyPicture
                        Application.Wait Now + TimeValue("00:00:01")
                        iSht.Select
                        Application.Wait Now + TimeValue("00:00:01")
                        iSht.Paste
                        Selection.Name = iCnt
                        Selection.Formula = "='" & Sht.Name & "'!" & .Range(.Cells(1,1),.Cells(eRow,eCol)).Address
                        Application.CutCopyMode = False
                        iCnt = iCnt + 1
                    End With
                End If
            End If
        Next
    End Sub

通过这段代码可以将26张图片自动存放在`img`工作表,并按生成时间自动编号.

实际过程中经常会报错,这时候就需要你手动调整了

[Excel]: https://blog.csdn.net/sinat_41870148/article/details/103055316
[20201103191918969.png_pic_center]: /images/20221120/9fce8f8cc02b4fb3b9bf930a4afd900f.png