批量打印带学籍号相片方法.doc

用Acdsee软件批量打印带学籍号相片方法以打印二寸相片为例进行说明：打开Acdsee-在文件夹内找到要打印的文件并选定（要确定点选界面右上角的“管理”选项卡）-点文件菜单下的打印-点联系表-大小处把列数和行数都定为2（调整间距可改变相片大小）-边框选项确定是否加边框-标题下在使用标题文本前勾选-插入元数据-文件属性-勾选文件名-字体：调整字体字号-文本对齐方式：确定文件名位置把右边的纸张大小选为A6(五寸相纸的尺寸)用word批量打印带学籍号相片方法以打印二寸相片为例进行说明：一、创建插入图片宏：新建word文档-工具-宏-在宏名处输入“插入图片”-点击右边“创建”-把代码对话框内的内容全删除-把以下代码内容复制入空白处-关闭visual basic编辑器二、运行宏插入图片：在已新建的word文档中-工具-宏-“插入图片”运行-在弹出的文本框中找到储存学籍相片的文件夹，插入学籍图片。三、可分栏打印：文件-页面设置-页边距设为1；格式-分栏-4栏确定后打印即可。复制以下虚线内代码-Sub 插入图片()Dim myfile As FileDialog Set myfile = Application.FileDialog(msoFileDialogFilePicker) With myfile .InitialFileName = C: If .Show = -1 Then For Each fn In .SelectedItems Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True) 按比例调整相片尺寸 WidthNum = mypic.Width c = 3.5 在此处修改相片宽,单位厘米 mypic.Width = c * 28.35 mypic.Height = (c * 28.35 / WidthNum) * mypic.Height If Selection.Start = ActiveDocument.Content.End - 1 Then 如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Selection.Text = Basename(fn) 函数取得文件名 Selection.EndKey If Selection.Start = ActiveDocument.Content.End - 1 Then 如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Next fn Else End If End With Set myfile = NothingEnd SubFunction Basename(FullPath) 取得文件名Dim x, yDim tmpstringtmpstring = FullPathx = Len(FullPath)For y = x To 1 Step -1If Mid(FullPath, y, 1) = Or _Mid(FullPath, y, 1) = : Or _Mid(FullPath, y, 1) = / Thentmpstring = Mid(FullPath, y + 1)Exit ForEnd IfNextBasename = Left(tmpstring, Len(tmpstring) - 4)End Function-以上是批量打印二寸相片的方法（二寸相片尺寸：3.5*5厘米）打印不同尺寸的相片可根据相片尺寸更改代码中以下内容的数字：“c = 3.5 在此处修改相片宽,单位厘米”以下是从网上下载的原始代码：Sub 插入图片()Dim myfile As FileDialog Set myfile = Application.FileDialog(msoFileDialogFilePicker) With myfile .InitialFileName = C: If .Show = -1 Then For Each fn In .SelectedItems Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True) mypic.Width = 400 根据需要设置 mypic.Height = 300 If Selection.Start = ActiveDocument.Content.End - 1 Then如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Selection.Text = Basename(fn) 函数取得文件名 Selection.EndKey If Selection.Start = ActiveDocument.Content.End - 1 Then如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Next fn Else End If End With Set myfile = NothingEnd SubFunction Basename(FullPath) 取得文件名Dim x, yDim tmpstringtmpstring = FullPathx = Len(FullPath)For y = x To 1 Step -1If Mid(FullPath, y, 1) = Or _Mid(FullPath, y, 1) = : Or _Mid(FullPath, y, 1) = / Thentmpstring = Mid(FullPath, y + 1)Exit ForEnd IfNextBasename = Left(tmpstring, Len(tmpstring) - 4)End Function以上代码打开文件夹，选择一个或多个图片插入，插入100多张图片比较慢，基本可以实现楼主想法，最好是在空白word文件中测试函数取得文件名代码是网上找的，稍加改动以上代码可用，且速度很快（我的是新配置的电脑），收藏了，谢谢白月清风。关于相片的大小，代码中用的是什么单位，可否用厘米？另外，可否让相片保持比例？（比如，大家交上来的相片大小不一，强制大小好多相片都变形了，我只让其宽度保持3厘米，高则按比例缩放）经测试 将 mypic.Width = 400 根据需要设置 mypic.Height = 300替换成下面代码即可按比例调整 按比例调整相片尺寸 WidthNum = mypic.Width c = 3 在此处修改相片宽,单位厘米 mypic.Width = c * 28.35 mypic.Height = (c * 28.35 / WidthNum) * mypic.HeightSub InsertPic() Dim myfile As FileDialog Set myfile = Application.FileDialog(msoFileDialogFilePicker) With myfile .InitialFileName = F: If .Show = -1 Then For Each fn In .SelectedItems Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True) 按比例调整相片尺寸 WidthNum = mypic.Width c = 10 在此处修改相片宽,单位厘米 mypic.Width = c * 28.35 mypic.Height = (c * 28.35 / WidthNum) * mypic.Height If Selection.Start = ActiveDocument.Content.End - 1 Then如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Selection.Text = Basename(fn) 函数取得文件名 Selection.EndKey If Selection.Start = ActiveDocument.Content.End - 1 Then如光标在文末 Selection.TypeParagraph 在文末添加一空段 Else Selection.MoveDown End If Next fn Else End If End With Set myfile = NothingEnd SubFunction Basename(FullPath) 取得文件名 Dim x, y Dim tmpstring tmpstring = FullPath x = Len(FullPath) For y = x To 1 Step