分享：自动形成连续单个证件或表格：自定义版式、自选项目、可有相片、可并排

lhdcxz

yanny2 发表于 2013-12-27 16:58
谢谢老师指点。如果要更进一步，我图片进行分类的话，而图片信息有一列的分类的名称的话，那么路径可以改吗 ...

当然可以。只要你把位置写对、图片放的位置和你写的位置一致就行。

蔡明江

谢谢分享，学习

悠哉游哉

希望在每张证件里加入统一的背景，请问应该怎么设置？

yanny2

（修改的材料系统，多级文件夹）我改了。但显示参数错误。并且相关链接路径，也不起作用。看来，要加多一项，也不是容易事啊。

1. Sub photo(reg As Range, iRow As Single, pname As String) ''把pname相片放到reg
   
2. With Sheet2
   
3. For iRow = 2 To .Cells(65536, 1).End(xlUp).Row
   
4.   FilPath = ThisWorkbook.Path & "\PIC" & Cells(iRow, 10) & pname & ".jpg"  '查找此名称的相片
   
5.      If Dir(FilPath) <> "" Then '找到
   
6.        ActiveSheet.Pictures.Insert(FilPath).Select '插入相片
   
7.        Selection.Placement = xlMoveAndSize '设置图片可以随单元格的变动而改变大小和位置
   
8.        Selection.ShapeRange.LockAspectRatio = msoFalse '取消图片纵横比锁定
   
9.        Selection.Top = reg.Top
   
10.        Selection.Left = reg.Left
    
11.        Selection.Width = reg.Width
    
12.        Selection.Height = reg.Height
    
13.      Else
    
14.       reg.Value = "本文件夹里" & Chr(10) & "找不到" & Chr(10) & "名字是" & Chr(10) & pname & Chr(10) & "的照片!"
    
15.      End If
    
16.      Next
    
17. End Sub

复制代码

lhdcxz

yanny2 发表于 2013-12-30 13:36
（修改的材料系统，多级文件夹）我改了。但显示参数错误。并且相关链接路径，也不起作用。看来，要加多一项 ...

注意：代码是在Sheet2循环的：
For iRow = 2 To .Cells(65536, 1).End(xlUp).Row
  FilPath = ThisWorkbook.Path & "\PIC\" & Cells(iRow, 10) & pname & ".jpg"  '查找此名称的相片
因此1、你在Sheet2的Cells(iRow, 10)单元格里面是不是一个路径？如果是，还要加个 “ . ” 和“\“
   即FilPath = ThisWorkbook.Path & "\PIC\" & .Cells(iRow, 10) & "\"  & pname & ".jpg"
2、如果不是，就要在Cells(iRow, 10)前面加上工作表名称

yanny2

谢谢老师。是的，我那是路径。即使添加了“ . ” 和“\“，还是显示参数不可选。

lhdcxz

yanny2 发表于 2013-12-30 16:56
谢谢老师。是的，我那是路径。即使添加了“ . ” 和“\“，还是显示参数不可选。

把附件发上来看看。

yanny2

老师，附件在153楼，开头的链接那里。就是开头有下划线的那个

lhdcxz

yanny2 发表于 2013-12-30 17:13
老师，附件在153楼，开头的链接那里。就是开头有下划线的那个

你打开看看。还有“链接”？怎么一开始就出现错误？还无法到这个模块呢。我是2003版本，可能无法调试。

lhdcxz

悠哉游哉 发表于 2013-12-30 12:32
希望在每张证件里加入统一的背景，请问应该怎么设置？

看看168楼是不是这个效果。