【案例】抗疫进行时，使用Excel催化剂+VBA制作人员出入证

上篇抗疫作案例作品中，使用了腾讯表单工具，收集用户健康码，今天又接到新任务，要收集用户照片，听说是用来制作一个出入证，可以临时放行一下。

这一次表单填报人员，异常积极，一下子就收集全了。

采集回来的照片，需要加工成如下样子（有一些个人信息说明，考虑到手机端制作有难度，最终使用了电脑端来制作）。

使用Excel催化剂对腾讯表单的图片进行批量下载功能，可参阅上一篇的讲解。

【案例】新冠抗疫后勤数字化支援，使用Excel催化剂快速完成健康码数据整理上报

如果制作一张图片，倒还简单，但制作几十张的话，就不淡定了，所以老规矩，使用自动化完成，写了一小段VBA代码，生成了发下的图片产物。

具体原理为，将PPT上做好的模板，图片人像替换成对应的图片，并将下方的文本也替换下。然后利用开头导出接口Export，导出图片。

代码如下：

代码语言：javascript复制

Sub 批量导出图片()
    
    Dim sl As Slide
    Dim shpUserPic As Shape
    Dim shpUserName As Shape
    Dim newShpPic As Shape
    
    Dim shpUnion As ShapeRange
    
    
    Dim arr
    
    arr = Array("502-李伟坚", "503-李XX")
    
    For Each picname In arr
        
        
        Set sl = Application.ActivePresentation.Slides(1)
        
        Set shpUserPic = sl.Shapes("userPic")
        Set shpUserName = sl.Shapes("userName")
        
        filePath = "C:Users19026Desktop照片" & picname & ".jpg"
        
        Set newShpPic = sl.Shapes.AddPicture(filePath, msoFalse, msoCTrue, shpUserPic.Top, shpUserPic.Top)
        newShpPic.LockAspectRatio = msoCTrue
        newShpPic.Width = shpUserPic.Width
        
        
        shpUserName.Left = newShpPic.Left
        
        shpUserName.Top = newShpPic.Top   newShpPic.Height
        
        shpUserName.Width = newShpPic.Width
        
        shpUserName.TextFrame2.TextRange.Text = "江源宾馆-" & picname
        
        
        shpUserPic.Delete
        
        newShpPic.Name = "userPic"
        
        
        Set shpUnion = sl.Shapes.Range(Array("userPic", "userName"))
        
        shpUnion.Export "C:Users19026Desktop合成照片" & picname & ".jpg", ppShapeFormatJPG
        
        
    Next
    
    
End Sub

没有写和Excel联动的代码，直接使用Excel催化剂的自定义函数StringJoin加工好Array的数组信息，硬代码写死的。

结语

万万没想到，数字化转型时代，真正最好用的还是手里的OFFICE工具，只要需求足够明确，简单事情重复做，立刻又是一个好的应用场景。

vba excel export 表单

0 人点赞