【AI+Excel效率革命】3分钟搞定学生花名册制作!

新闻

作者：微信文章
还在为制作班级花名册而烦恼？班主任、辅导员、家委们的福音来啦！传统手工操作需要几小时的工作，现在用AI+Excel只需3分钟就能完成～

✨核心功能亮点：
1️、智能分类：自动按性别分页，男生女生一目了然
2️、整齐排版：每行5张照片，自动对齐不费心
3️、一键生成：从Excel到Word全自动完成
4️、智能纠错：自动检测缺失照片并标注

🔧超简单三步操作：

1.准备学生照片（确保文件名与Excel姓名一致）

2.复制提供的VBA代码（文末获取）

3.运行宏自动生成花名册

💡实际应用场景

·班主任制作班级花名册

·辅导员管理学生档案

·活动组织人员制作参会名单

·人事部门整理员工信息

打开千问（其他AI工具也可以实现），输入提示语：

请根据上传的excel文件，把excel文件中照片导入到Word文档，男生一页，女生一页，每行放5张照片，请用VBA解决。一分钟后千问就提供了VBA代码。

执行代码之前需要做好以下准备：

1、将所有学生的照片放入一个文件夹。

2、 照片文件名必须与Excel中的姓名完全一致。

3、 打开 Excel，按 ALT + F11 进入 VBA 编辑器，插入一个新模块，粘贴上面的代码。

运行宏 【ALT + F8】，运行后，您将得到一个 Word 文档，男生和女生的照片将分别在独立的两页上，每页都是每行5张照片的整齐布局。

代码如下：

Sub CreatePhotoDocument()

' 声明变量

Dim wdApp, wdDoc, tbl

Dim ws

Dim LastRow, i

Dim Name, Gender

Dim PhotoWidth, PhotoHeight

Dim PhotoFolderPath, PhotoExtension, PhotoPath

Dim Count, RowsNeeded

Dim CurrentRow, CurrentCol

Const MaxCols As Integer = 5 ' 每行5张照片



' ================== 用户配置区==================

' 1. 修改为您存放照片的文件夹路径（末尾必须有反斜杠 \）

PhotoFolderPath = "C:\Users\YourName\Pictures\照片\" ' <<< 必须修改！



' 2. 修改为照片的实际格式

PhotoExtension = ".jpg" ' <<< 必须修改！例如 .png, .jpeg



' 3. 设置照片大小（厘米）

PhotoWidth = 3.2  

PhotoHeight = 4.2

' ==============================================



' 设置工作表

Set ws = ThisWorkbook.Sheets(1)



' 找到数据最后一行

LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row



' 创建Word

Set wdApp = CreateObject("Word.Application")

Set wdDoc = wdApp.Documents.Add

wdApp.Visible = True



' --- 处理男生 ---

wdDoc.Content.Text = "男生照片" & vbCrLf

wdDoc.Content.Paragraphs.Last.Alignment = 1 ' 标题居中



' 计算男生人数

Count = 0

For i = 2 To LastRow

If Trim(ws.Cells(i, 4).Value) = "男" Then Count = Count + 1

Next i



RowsNeeded = Int((Count + MaxCols - 1) / MaxCols) ' 向上取整 (21/5=4.2 -> 5行)



' 插入男生表格

Set tbl = wdDoc.Tables.Add(wdDoc.Bookmarks("\EndOfDoc").Range, RowsNeeded, MaxCols)

tbl.Borders.Enable = False

tbl.Range.ParagraphFormat.Alignment = 1



CurrentRow = 1

CurrentCol = 1



For i = 2 To LastRow

Name = Trim(ws.Cells(i, 2).Value)

Gender = Trim(ws.Cells(i, 4).Value)



If Gender = "男" And Name <> "" Then

PhotoPath = PhotoFolderPath & Name & PhotoExtension



Set cellRange = tbl.Cell(CurrentRow, CurrentCol).Range

cellRange.Text = ""



If Dir(PhotoPath) <> "" Then

cellRange.InlineShapes.AddPicture PhotoPath, False, True

With cellRange.InlineShapes(1)

.Width = PhotoWidth * 28.3465

.Height = PhotoHeight * 28.3465

End With

Else

cellRange.Text = "[照片]" & vbCrLf & "未找到"

End If



cellRange.InsertAfter vbCrLf & Name



CurrentCol = CurrentCol + 1

If CurrentCol > MaxCols Then

CurrentCol = 1

CurrentRow = CurrentRow + 1

End If

End If

Next i



' --- 插入分页符 ---

wdDoc.Content.InsertAfter vbCrLf

wdDoc.Content.InsertParagraphAfter

wdDoc.Content.Paragraphs.Last.Range.InsertBreak 7 ' 分页符



' --- 处理女生 ---

wdDoc.Content.InsertAfter "女生照片" & vbCrLf

wdDoc.Content.Paragraphs.Last.Alignment = 1



' 计算女生人数

Count = 0

For i = 2 To LastRow

If Trim(ws.Cells(i, 4).Value) = "女" Then Count = Count + 1

Next i



RowsNeeded = Int((Count + MaxCols - 1) / MaxCols) ' 20/5=4行



' 插入女生表格

Set tbl = wdDoc.Tables.Add(wdDoc.Bookmarks("\EndOfDoc").Range, RowsNeeded, MaxCols)

tbl.Borders.Enable = False

tbl.Range.ParagraphFormat.Alignment = 1



CurrentRow = 1

CurrentCol = 1



For i = 2 To LastRow

Name = Trim(ws.Cells(i, 2).Value)

Gender = Trim(ws.Cells(i, 4).Value)



If Gender = "女" And Name <> "" Then

PhotoPath = PhotoFolderPath & Name & PhotoExtension



Set cellRange = tbl.Cell(CurrentRow, CurrentCol).Range

cellRange.Text = ""



If Dir(PhotoPath) <> "" Then

cellRange.InlineShapes.AddPicture PhotoPath, False, True

With cellRange.InlineShapes(1)

.Width = PhotoWidth * 28.3465

.Height = PhotoHeight * 28.3465

End With

Else

cellRange.Text = "[照片]" & vbCrLf & "未找到"

End If



cellRange.InsertAfter vbCrLf & Name



CurrentCol = CurrentCol + 1

If CurrentCol > MaxCols Then

CurrentCol = 1

CurrentRow = CurrentRow + 1

End If

End If

Next i



MsgBox "照片文档生成完成！", 64, "提示"

End Sub

你如果想学习更多的AI在Excel中的应用，可以报名AI赋能Excel课程，优惠价199元，课程案例20多个，从数据清洗到数据可视化都有。