VBA批量生成审批表,增加批量添加照片功能

fxl447098457

将image控件换成了word里面的自带的矩形形状了。

1. Sub chaifen()
   
2. Dim DocApp As Object, Mydoc As Object, sht As Worksheet
   
3. Dim tb As Object, myname As String, i As Integer
   
4. Set DocApp = CreateObject("Word.application")
   
5. Application.ScreenUpdating = False
   
6. Set Mydoc = DocApp.Documents.Open(ThisWorkbook.Path & "\模板.doc")
   
7. Set sht = Sheets("File")
   
8. arr = sht.Range("A2:BY" & sht.Cells(Rows.Count, 1).End(3).Row)
   
9. Set tb = Mydoc.Tables(1)
   
10. With tb
    
11.   For i = 1 To UBound(arr)
    
12.   myname = ThisWorkbook.Path & "" & arr(i, 3) & ".doc"
    
13.   If Dir(myname) <> "" Then Kill myname
    
14. .Cell(1, 2).Range.Text = arr(i, 3)
    
15. .Cell(1, 4).Range.Text = arr(i, 7)
    
16. .Cell(1, 6).Range.Text = arr(i, 8)
    
17. .Cell(2, 2).Range.Text = arr(i, 56)
    
18. .Cell(2, 4).Range.Text = arr(i, 57)
    
19. .Cell(2, 6).Range.Text = arr(i, 36)
    
20. .Cell(3, 2).Range.Text = arr(i, 41)
    
21. .Cell(3, 4).Range.Text = arr(i, 14)
    
22. Mydoc.Shapes(1).Fill.UserPicture ThisWorkbook.Path & "\照片包" & arr(i, 3) & ".jpg"
    
23. Mydoc.SaveAs2 myname, 0
    
24. Next
    
25. .Parent.Close 0
    
26. End With
    
27. DocApp.Quit
    
28. Application.ScreenUpdating = True
    
29. Set DocApp = Nothing
    
30. Set Mydoc = Nothing
    
31. Set sht = Nothing
    
32. Set tb = Nothing
    
33. End Sub

复制代码

VBA批量生成审批表.rar (67.59 KB, 下载次数: 83)

2016-12-2 23:02 上传

点击文件名下载附件

yjwdjfqb

fxl447098457 发表于 2016-12-2 23:02
将image控件换成了word里面的自带的矩形形状了。

老师谢谢你了，很好用！

kszcs

fxl447098457 发表于 2016-12-2 23:02
将image控件换成了word里面的自带的矩形形状了。

谢谢fxl447098457老师！
运行代码，提示错误，第23行代码标黄。
麻烦老师看看

aizaishenqiu

学习了啊，谢谢！！！！

yjwdjfqb

kszcs 发表于 2016-12-5 11:59
谢谢fxl447098457老师！
运行代码，提示错误，第23行代码标黄。
麻烦老师看看

23.Mydoc.SaveAs2 myname, 0

应该是你OFFICE版本问题，
如果你是2003版本，则改成　Mydoc.SaveAs myname, 0

如果是2007版本的，则就是 Mydoc.SaveAs2 myname, 0

kszcs

yjwdjfqb 发表于 2016-12-5 22:36
23.Mydoc.SaveAs2 myname, 0

应该是你OFFICE版本问题，

谢谢，好用了

jinhaitiao16

感谢楼主分享

AFree123

fxl447098457 发表于 2016-12-2 23:02
将image控件换成了word里面的自带的矩形形状了。

请教老师：
win8，office2007版，提示：运行时错误438，对象不支持该属性或方法
Mydoc.SaveAs2 myname, 0显示黄色底
这是什么问题？该如何解决？谢谢！

LMY123

VBA批量生成WORD审批表,增加批量添加照片功能