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

lhdcxz · 发表于 2013-12-31 14:24

本帖最后由 lhdcxz 于 2013-12-31 14:34 编辑

你的 Call photo(Sheet3.Range(Cells(i + 10, 28 + j).Value), Sheet2.Cells(2, nn)) 是2个参数
而你改的 Sub photo(reg As Range, iRow As Single, pname As String) ''把pname相片放到reg 是3个参数
所以出现错误。
而且，既然iRow作为子程序入口参数（iRow As Single也不对，应该是 As Integer 或者As  Long）
那么就不能再子程序里面赋值 iRow = 2...
  With Sheet2
  For iRow = 2 To .Cells(65536, 1).End(xlUp).Row 错误：改变了原始参数的值（iRow只能引用）

yanny2 · 发表于 2013-12-31 11:49

本帖最后由 yanny2 于 2013-12-31 12:10 编辑

lhdcxz 发表于 2013-12-30 17:53
你打开看看。还有“链接”？怎么一开始就出现错误？还无法到这个模块呢。我是2003版本，可能无法调试。

哦，我的是2010版的。不知道代码应用上，10版和03版语法是不是不一样呢？
我可以打开啊，然后其它都运行正常，就是运行到那个call photo处就显示参数不可选。所以，感觉应该是那个路径的设置吧。但要怎么设置呢？是不是因为panme不是在sheet2的，而我的分类项在sheet2，而造成混乱了呢？那可不可以像pname一样做一个分类项的代名呢？

材料检索系统2003版.zip (180.96 KB, 下载次数: 60) 我加入了我的数据。其实应该就是我的那个代码路径修改有问题。附件我用你的表修改，保存了还是03版的。

00锋刃00 · 发表于 2013-12-30 21:30

试试看看。。。

lhdcxz · 发表于 2013-12-30 18:20

本帖最后由 lhdcxz 于 2014-1-2 10:08 编辑

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

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

lhdcxz · 发表于 2013-12-30 17:53

本帖最后由 lhdcxz 于 2013-12-30 18:17 编辑

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

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

yanny2 · 发表于 2013-12-30 17:13

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

lhdcxz · 发表于 2013-12-30 17:05

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

把附件发上来看看。

yanny2 · 发表于 2013-12-30 16:56

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

lhdcxz · 发表于 2013-12-30 14:41

本帖最后由 lhdcxz 于 2013-12-30 14:43 编辑

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 · 发表于 2013-12-30 13:36

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

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

复制代码

		自动登录	找回密码
密码			免费注册