我的目标:让中国的大学生走出校门的那一刻就已经具备这些office技能中创网,让职场人士能高效使用office为其服务。支持我,也为自己加油!

真知灼见,首先来自多思善疑。——洛克威尔

前几天,有位会员遇到一个问题,需要把Excel中的内容按照分页符截取成一份一份的图片并另存到其它路径。

比如:

上表中的有很多分页符照片转换成excel,所以在打印状态下可以看出每一页的数据条数并不相同,现在要根据这些分页符的位置,把数据截取成图片并导出。

如果是手工操作的话,不仅要找出分页符的位置,还要选定内容,用截图工具截取,然后另存为图片,数据多的话这个工作肯定挺很费劲。

怎么用VBA自动化该过程呢?

如下效果:在桌面上新建一个文件夹用来放图片照片转换成excel,点下导出按钮就OK了。

excel转换成pdf在线转换_excel转换所要求格式_照片转换成excel

代码如下:

'按由分页符分割的区间转化为图片并导出Sub 批量把区域转化为图片并导出到某文件夹()    Dim hpbs As Object, rng As Range    Dim arr, s%, a1%, a2%, i%, pah$        Application.ScreenUpdating = False    Set hpbs = ActiveSheet.HPageBreaks    pah = "C:UserspengDesktop图片"    s = hpbs.Count        '设定区域的初始上边界    a1 = 1        '根据每个分页符所在的行号确定区域并导出    For i = 1 To s + 1            '确定区域的下边界        If i < s + 1 Then            a2 = hpbs.Item(i).Location.Row - 1        Else            a2 = ActiveSheet.Cells(Rows.Count, 1).End(3).Row        End If                '确定区域并复制成图片        Set rng = Range(Cells(a1, 1), Cells(a2, "g"))        rng.CopyPicture xlScreen, xlPicture                '在工作表中插入一个图表并把图片粘贴进去然后导出        With ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height).Chart            .Parent.Select    '(粘贴之前先选中,否则导出图片为空白)            .Paste            .Export pah & "" & i & ".jpg"            .Parent.Delete        End With                '下边界加1正好为下个区域的上边界        a1 = a2 + 1    Next        Application.ScreenUpdating = True    End Sub

涉及的知识点:

1、认识分页符对象集合HPageBreaks

2、了解怎么从分页符对象集合中取出每个分页符对象并知道它所在的行号HPageBreaks.Item(i).Location.Row

3、知道了每个分页符所在的行号就好确定区域了,确定好区域后把其复制成为图片,Excel中的图片是不能直接另存到其它路径的,要寻找一个迂回的办法。

4、通过新建一个图表容器,然后把图片装进去,再导出

5、把图片装入图表之前一定要先选中图表,否则导出的图片为空白图片。

最新培训课程信息:

2月20日:函数培训班

2月25日:VBA培训班

2月25日:图表培训班

发表回复

您的电子邮箱地址不会被公开。 必填项已用*标注