Excel VBA 工资表批量截图/工资条保存为图片文件

2024-05-24 00:29| 来源: 网络整理| 查看: 265

本文于2023年8月26日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】

实用案例

|收费管理系统|中医诊所收费系统||日期控件|简单的收发存||电子发票管理助手|Excel表格拆分神器|

|Excel多种类型文件合并||电子发票登记系统（Access版）||批量生成凭证抽查底稿|

收费使用项目

|财务管理系统|

内容提要工资表数据按人员筛选到新工作表工资条删除空白列工资条导出保存为图片文件

大家好，我是冷水泡茶，今天在网上论坛看到一个求助贴，他要把工资表按员工筛选，然后截图，他的问题是：如何能在筛选的时候，自动隐藏金额为0的列，这样表格就会窄一点，方便截图？

如果要解决这样的问题，我想是不是可以参考【Excel VBA 工作表突出显示行列高亮】一文中所采用的方法：把原来的列宽先记下来，筛选后，再把金额为0的列的列宽设为0，在下次筛选前先恢复？虽然我是这样想的，但我并没有去做。

如果我来处理工资条，我们有文件拆分的小工具【Excel VBA 文件拆分工具功能扩展】按人员进行拆分，可以完成按人制作工资条这件事。

他的问题引起我思考的是，楼主可能是手工截图，如果人员很多的话，是不是也有点累人？

于是，我就突发奇想，是不是可以一键生成所有员工的工资条截图？

经过一个下午的努力，终于完成，我们一起来看一下：

基本思路

1、在工资表中按员工逐一筛选，把筛选的结果复制到新的工作表，命名为“工资条”。

2、把工资条”表中金额为0，或为空的列删除。

3、把工资条复制，粘贴为图片。

4、建立一个图表，再把图片粘贴进去。

5、从图表中导出图片，按员工姓名+当前时间，保存在“C:\工资条”目录下。

程序代码

1、模块1，CaptureData过程，工资条截图：

Sub CaptureData() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim employeeName As String Dim currentRow As Range Dim OutputFolder As String Dim OutputFile As String Dim lastRow As Integer Dim iCol As Integer Dim rng As Range, pic As Object Dim objCht As ChartObject Application.DisplayAlerts = False Application.ScreenUpdating = False Set wsSource = ThisWorkbook.Sheets("工资总表") On Error Resume Next Set wsDestination = ThisWorkbook.Sheets("工资条") On Error GoTo 0 If wsDestination Is Nothing Then Set wsDestination = ThisWorkbook.Sheets.Add wsDestination.Name = "工资条" Else wsDestination.Cells.Clear End If lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row For i = 3 To lastRow Set currentRow = wsSource.Rows(i) employeeName = currentRow.Cells(1, 3).Value If employeeName "" Then wsSource.Rows(2).AutoFilter Field:=3, Criteria1:=employeeName Application.CalculateFull wsSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy wsDestination.Cells(1, 1) wsSource.Rows(2).AutoFilter Field:=3 Set rng = wsDestination.Cells(3, 1).Resize(1, wsDestination.UsedRange.Columns.Count) For iCol = rng.Cells.Count To 1 Step -1 If IsEmpty(rng.Cells(1, iCol).Value) Or rng.Cells(1, iCol).Value = 0 Then rng.Cells(1, iCol).EntireColumn.Delete End If Next wsDestination.Activate Set rng = wsDestination.Cells(1, 1).Resize(3, wsDestination.UsedRange.Columns.Count) rng.Copy Set pic = ActiveSheet.Pictures.Paste pic.Copy OutputFolder = "C:\工资条" If Not Dir(OutputFolder, vbDirectory) "" Then MkDir OutputFolder End If OutputFile = OutputFolder & "\" & employeeName & "(" & Format(Now, "YYYYMMDDhhmmss") & ").jpg" Set objCht = wsDestination.ChartObjects.Add(0, 0, rng.Width, rng.Height) With objCht.Chart .Parent.Select .Paste .Export OutputFile, "JPG" .Parent.Delete End With pic.Delete wsDestination.UsedRange.Clear End If Next wsDestination.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Done!" End Sub

‍代码解析：

（1）定义一些变量，工作表对象ws，Range对象，图表对象等。

（2）line12~13，关闭屏幕更新、警告。

（3）line14，设置数据源表wsSource为“工资总表”。

（4）line15~23，设置目标表wsDestination为“工资条”，这里先检查该表存不存在，不存在就新建，存在就清除内容。实际上应该是不存在的，因为在过程结束前我们把这张表张删除了。

（5）line24~59，循环“工资总表”，逐一把员工的工资条保存为图片。

（a）line29~30，筛选工资表，全表重算，主要是他第一行有公式，不重算值不改变。

（b）line31，把筛选结果复制到“工资条”表。

（c）line32~38，删除金额为0或空的列。

（d）line40~43，复制工资条数据区域，粘贴为图片，复制图片。

（e）line44~48，建立输出目录与文件名。

（f）line49~55，插入图表，粘贴图片，导出保存。

（g）line56~57，删除“工资条”表中的图片，清除“工资条”表的内容，准备处理下一条记录。

（6）line60~62，删除“工资条“表，恢复屏幕更新、警告。

2、其他过程：CmdCapture，截图命令按钮：

Private Sub CmdCapture_Click() Call CaptureData End SubTips

1、在添加临时工作表时，我们要先检查工作表是否存在，如果不存在就添加，存在就清空内容备用，如果不管三七二十一直接添加的话，要么报错，要么会增加不少多余的工作表。

2、工作表筛选、复制、粘贴的方法。

3、复制区域，另存为图片的方法。

4、利用工作表中的图表对象，可以把工作表中的图片导出，保存为图片文件。

5、输出目录的处理，我们可以在根目录下建立一个文件夹，跟添加工作表一样，我们先判断它是否存在，不存在才新建，避免报错。

......

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！

需要示例文件的朋友请稍微留意一下：

本文使用文章同步助手同步，本文于2023年8月26日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

【本文地址】

公司简介

联系我们