[已解决]用VBA调入相应的相片?

qqyyh · 发表于 2017-3-5 17:22

求助大神用VBA调入相应的相片?

求助.rar (803.51 KB, 下载次数: 12)

老司机带带我 · 发表于 2017-3-5 20:58

A4单元格值等于0的时候取前6张照片，等于6的时候取7-12张？

qqyyh · 发表于 2017-3-5 21:39

意思是一样的

苏子龙 · 发表于 2017-3-6 16:55

试做了下，不知道楼主想做什么？

qqyyh · 发表于 2017-3-6 21:01

谢谢！在一张3r的相纸打印出来裁剪,麻烦你了。

苏子龙 · 发表于 2017-3-7 10:07

照片都放进去后直接可以打印，见附件

qqyyh · 发表于 2017-3-7 10:26

苏子龙发表于 2017-3-7 10:07
照片都放进去后直接可以打印，见附件

谢谢！我先测试一下，再给最佳。

qqyyh · 发表于 2017-3-7 10:35

本帖最后由 qqyyh 于 2017-3-7 20:14 编辑

两个问题需要解决：1、照片与照片间需要留空隙，便于裁剪。2、选12，运行宏，要删除前面6张的照片才行，不然出现重叠了。谢谢

叫我赵日天 · 发表于 2017-3-7 13:02

本帖最后由叫我赵日天于 2017-3-7 13:04 编辑

Sub tt3()
Dim num%, i%, stpNum%
Dim Myph$, TpNm$, arr, Tp As Shape
For Each Tp In ActiveSheet.Shapes
If Tp.Type = 11 Then Tp.Delete
Next
Range("1:3").ClearContents
num = Range("a4").Value
Myph = ThisWorkbook.Path & "\photo"
arr = Sheets("名单").Range(Sheets("名单").Cells(IIf([a4] = 6, 2, [a4] - 4), 2), Sheets("名单").Cells([a4] + 1, 2))
Do While stpNum < num
For i = 1 To 3
stpNum = stpNum + 1
TpNm = arr(stpNum, 1)
If Dir(Myph & TpNm & ".jpg") <> "" Then
With Cells(i, Int((stpNum - 1) / 3) + 1)
.Value = TpNm
Sheets("打印页").Shapes.AddPicture Filename:=Myph & TpNm & ".jpg", LinkToFile:=True, SaveWithDocument:=True, _
Left:=.Left + 5, Top:=.Top + 5, Width:=.Width - 10, Height:=.Height - 10
End With
End If
On Error GoTo err
Next
Loop
err:
Application.EnableEvents = True
End Sub

复制代码

qqyyh · 发表于 2017-3-7 13:24

叫我赵日天发表于 2017-3-7 13:02

太谢谢你！附件能完整上传吗？我测试不成功的

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