批量插入图片制作出入卡或者胸卡

3190496160

1、可以生成两种底色的出入卡，走读生和住校生出入卡
2、可以选择打印范围，
3、可以根据姓名插入相应的图片
学生出入卡.rar (1.8 MB, 下载次数: 385)

2020-5-23 17:26 上传

点击文件名下载附件

3190496160

1. Sub 生成住校生校牌()
   
2. Application.ScreenUpdating = False
   
3. Dim x, k, m, f As Integer
   
4. Dim fs1$, fs2$
   
5. For Each a In Sheets("打印住校").Shapes
   
6.     a.Delete
   
7. Next
   
8. 
   
9. Sheets("打印住校").Rows("11:65535").Delete
   
10. Sheets("打印住校").Range("B5:C5,B6:C6,B7:D7,B8:D8,B9:D9,G5:H5,G6:H6,G7:I7,G8:I8,G9:I9").ClearContents
    
11. k = Sheets("住校").Cells(Rows.Count, 1).End(xlUp).Row
    
12. If Int((k - 1) / 2) = (k - 1) / 2 Then
    
13. f = k / 2 - 1
    
14. Else
    
15. f = Int((k - 1) / 2)
    
16. End If
    
17. For m = 1 To f
    
18. Sheets("打印住校").Rows("1:10").Copy Sheets("打印住校").Cells(Rows.Count, 1).End(xlUp).Offset(2)
    
19. Next m
    
20. For x = 2 To k Step 2
    
21. Sheets("打印住校").Cells(x * 4.5 - 4, 2) = Sheets("住校").Cells(x, 2).Value
    
22. Sheets("打印住校").Cells(x * 4.5 - 3, 2) = Sheets("住校").Cells(x, 3).Value
    
23. Sheets("打印住校").Cells(x * 4.5 - 2, 2) = Sheets("住校").Cells(x, 4).Value
    
24. Sheets("打印住校").Cells(x * 4.5 - 1, 2) = Sheets("住校").Cells(x, 5).Value
    
25. Sheets("打印住校").Cells(x * 4.5, 2) = Sheets("住校").Cells(x, 6).Value
    
26. 
    
27. Sheets("打印住校").Cells(x * 4.5 - 4, 7) = Sheets("住校").Cells(x + 1, 2).Value
    
28. Sheets("打印住校").Cells(x * 4.5 - 3, 7) = Sheets("住校").Cells(x + 1, 3).Value
    
29. Sheets("打印住校").Cells(x * 4.5 - 2, 7) = Sheets("住校").Cells(x + 1, 4).Value
    
30. Sheets("打印住校").Cells(x * 4.5 - 1, 7) = Sheets("住校").Cells(x + 1, 5).Value
    
31. Sheets("打印住校").Cells(x * 4.5, 7) = Sheets("住校").Cells(x + 1, 6).Value
    
32. 
    
33. fs1 = ThisWorkbook.Path & "\学生照片" & CStr(Sheets("住校").Cells(x, 2)) & ".jpg"
    
34.     If Dir(fs1) <> "" Then
    
35.     Sheets("打印住校").Select
    
36.        Sheets("打印住校").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Select
    
37.        ActiveSheet.Pictures.Insert(fs1).Select
    
38.        With Selection
    
39.             .Top = Sheets("打印住校").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Top + 1
    
40.             .Left = Sheets("打印住校").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Left + 1
    
41.             .Width = Sheets("打印住校").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Width - 1
    
42.             .Height = Sheets("打印住校").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Height - 1
    
43.         End With
    
44.     End If
    
45.     fs2 = ThisWorkbook.Path & "\学生照片" & CStr(Sheets("住校").Cells(x + 1, 2)) & ".jpg"
    
46.     If Dir(fs2) <> "" Then
    
47.        Sheets("打印住校").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Select
    
48.        ActiveSheet.Pictures.Insert(fs2).Select
    
49.        With Selection
    
50.              .Top = Sheets("打印住校").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Top + 1
    
51.             .Left = Sheets("打印住校").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Left + 1
    
52.             .Width = Sheets("打印住校").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Width - 1
    
53.             .Height = Sheets("打印住校").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Height - 1
    
54.         End With
    
55.     End If
    
56. 
    
57. Next x
    
58. Application.ScreenUpdating = True
    
59. End Sub
    
60. 
    

复制代码

3190496160

1. Sub 生成走读生校牌()
   
2. Application.ScreenUpdating = False
   
3. Dim x, k, m, f As Integer
   
4. Dim fs1$, fs2$
   
5. For Each a In Sheets("打印走读").Shapes
   
6.     a.Delete
   
7. Next
   
8. 
   
9. Sheets("打印走读").Rows("11:65535").Delete
   
10. Sheets("打印走读").Range("B5:C5,B6:C6,B7:D7,B8:D8,B9:D9,G5:H5,G6:H6,G7:I7,G8:I8,G9:I9").ClearContents
    
11. k = Sheets("走读").Cells(Rows.Count, 1).End(xlUp).Row
    
12. If Int((k - 1) / 2) = (k - 1) / 2 Then
    
13. f = k / 2 - 1
    
14. Else
    
15. f = Int((k - 1) / 2)
    
16. End If
    
17. For m = 1 To f
    
18. Sheets("打印走读").Rows("1:10").Copy Sheets("打印走读").Cells(Rows.Count, 1).End(xlUp).Offset(2)
    
19. Next m
    
20. For x = 2 To k Step 2
    
21. Sheets("打印走读").Cells(x * 4.5 - 4, 2) = Sheets("走读").Cells(x, 2).Value
    
22. Sheets("打印走读").Cells(x * 4.5 - 3, 2) = Sheets("走读").Cells(x, 3).Value
    
23. Sheets("打印走读").Cells(x * 4.5 - 2, 2) = Sheets("走读").Cells(x, 4).Value
    
24. Sheets("打印走读").Cells(x * 4.5 - 1, 2) = Sheets("走读").Cells(x, 5).Value
    
25. Sheets("打印走读").Cells(x * 4.5, 2) = Sheets("走读").Cells(x, 6).Value
    
26. 
    
27. Sheets("打印走读").Cells(x * 4.5 - 4, 7) = Sheets("走读").Cells(x + 1, 2).Value
    
28. Sheets("打印走读").Cells(x * 4.5 - 3, 7) = Sheets("走读").Cells(x + 1, 3).Value
    
29. Sheets("打印走读").Cells(x * 4.5 - 2, 7) = Sheets("走读").Cells(x + 1, 4).Value
    
30. Sheets("打印走读").Cells(x * 4.5 - 1, 7) = Sheets("走读").Cells(x + 1, 5).Value
    
31. Sheets("打印走读").Cells(x * 4.5, 7) = Sheets("走读").Cells(x + 1, 6).Value
    
32. 
    
33. fs1 = ThisWorkbook.Path & "\学生照片" & CStr(Sheets("走读").Cells(x, 2)) & ".jpg"
    
34.     If Dir(fs1) <> "" Then
    
35.     Sheets("打印走读").Select
    
36.        Sheets("打印走读").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Select
    
37.        ActiveSheet.Pictures.Insert(fs1).Select
    
38.        With Selection
    
39.             .Top = Sheets("打印走读").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Top + 1
    
40.             .Left = Sheets("打印走读").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Left + 1
    
41.             .Width = Sheets("打印走读").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Width - 1
    
42.             .Height = Sheets("打印走读").Range("b" & x * 4.5 - 5 & ":c" & x * 4.5 - 5).Height - 1
    
43.         End With
    
44.     End If
    
45.     fs2 = ThisWorkbook.Path & "\学生照片" & CStr(Sheets("走读").Cells(x + 1, 2)) & ".jpg"
    
46.     If Dir(fs2) <> "" Then
    
47.        Sheets("打印走读").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Select
    
48.        ActiveSheet.Pictures.Insert(fs2).Select
    
49.        With Selection
    
50.              .Top = Sheets("打印走读").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Top + 1
    
51.             .Left = Sheets("打印走读").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Left + 1
    
52.             .Width = Sheets("打印走读").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Width - 1
    
53.             .Height = Sheets("打印走读").Range("g" & x * 4.5 - 5 & ":h" & x * 4.5 - 5).Height - 1
    
54.         End With
    
55.     End If
    
56. 
    
57. Next x
    
58. Application.ScreenUpdating = True
    
59. End Sub
    
60. 
    

复制代码

3190496160

打印窗体代码
Private Sub ComboBox1_Change()
Sheets("打印" & ComboBox1).Select
End Sub

Private Sub CommandButton1_Click()
If TextBox1.Text = "" Then MsgBox "请输入要打印的起始页": Exit Sub
If TextBox2.Text = "" Then MsgBox "请输入要打印的终止页": Exit Sub

Sheets("打印" & ComboBox1).PrintOut From:=TextBox1.Text, To:=TextBox2.Text, Copies:=1
End
End Sub

Private Sub CommandButton2_Click()
End
End Sub

Private Sub TextBox1_Change()
If cimbobox1 = "" Then MsgBox "请选择学生类型": Exit Sub
End Sub

Private Sub UserForm_Initialize()
Me.ComboBox1.List = Array("走读", "住校")
End Sub

xvjiex

批量插入图片制作出入卡或者胸卡，感谢3190496160分享！

四小

楼主：用了，很好用，能否写点批注解释，好根据实际情况自己动手修改一下。自己是个小白，很多都不懂。谢谢！

3190496160

四小 发表于 2021-3-19 11:46
楼主：用了，很好用，能否写点批注解释，好根据实际情况自己动手修改一下。自己是个小白，很多都不懂。谢谢 ...

没有人愿意做注释代码这种枯燥乏味的事的，除非是有偿

四小

3190496160 发表于 2021-3-19 11:51
没有人愿意做注释代码这种枯燥乏味的事的，除非是有偿

qq联系吗？如果加背景图片这样批量加入？

3190496160

四小 发表于 2021-3-21 21:23
qq联系吗？如果加背景图片这样批量加入？

名称就是QQ号

szchuxin

谢谢楼主分享，这几天刚好在找这方面的程序！