[已解决]求助：卡片循环打印函数公式

夹竹桃

大家好！问题在文件夹里了，麻烦大家看看。
首先感谢大家了！

最佳答案

月排行榜 / 总排行榜

suye1010

2012-9-25 22:42

1. Sub PRwithPic(All As Boolean)
   
2. Dim i As Integer, PageNo As Integer, j As Integer, k As Integer, ItemNo, Pic
   
3. On Error Resume Next
   
4. ActiveSheet.PageSetup.PrintArea = "$A$1:$G$28"
   
5. If All Then
   
6.     PageNo = 1000
   
7. Else
   
8.     PageNo = Cells(2, 11)
   
9. End If
   
10. If PageNo * 8 + 1 < Sheet1.Cells(65536, 1).End(xlUp).Row Then
    
11.     ItemNo = PageNo * 8 + 1
    
12. Else
    
13.     ItemNo = Sheet1.Cells(65536, 1).End(xlUp).Row
    
14. End If
    
15. 
    
16. For i = 2 To ItemNo Step 8
    
17.     ActiveSheet.Pictures.Delete
    
18.     For j = 1 To 8
    
19.         For k = 1 To 5
    
20.             Cells(Int((j - 1) / 2) * 7 + k + 1, IIf(j Mod 2, 2, 6)) = Sheet1.Cells(i + j - 1, k + 1)
    
21.         Next k
    
22.             Set Pic = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Sheet1.Cells(i + j - 1, 7))
    
23.             Pic.ShapeRange.Left = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Left
    
24.             Pic.ShapeRange.Top = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Top
    
25.             Pic.ShapeRange.Width = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Width
    
26.             Pic.ShapeRange.Height = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Height * 4
    
27.     Next j
    
28.     ActiveSheet.PrintOut
    
29. Next i
    
30. End Sub
    
31. 
    
32. Sub PAll()
    
33. Call PRwithPic(True)
    
34. End Sub
    
35. Sub Ppage()
    
36. Call PRwithPic(False)
    
37. End Sub

复制代码

跳转到最佳答案楼层

suye1010

1. Sub PRwithPic(All As Boolean)
   
2. Dim i As Integer, PageNo As Integer, j As Integer, k As Integer, ItemNo, Pic
   
3. On Error Resume Next
   
4. ActiveSheet.PageSetup.PrintArea = "$A$1:$G$28"
   
5. If All Then
   
6.     PageNo = 1000
   
7. Else
   
8.     PageNo = Cells(2, 11)
   
9. End If
   
10. If PageNo * 8 + 1 < Sheet1.Cells(65536, 1).End(xlUp).Row Then
    
11.     ItemNo = PageNo * 8 + 1
    
12. Else
    
13.     ItemNo = Sheet1.Cells(65536, 1).End(xlUp).Row
    
14. End If
    
15. 
    
16. For i = 2 To ItemNo Step 8
    
17.     ActiveSheet.Pictures.Delete
    
18.     For j = 1 To 8
    
19.         For k = 1 To 5
    
20.             Cells(Int((j - 1) / 2) * 7 + k + 1, IIf(j Mod 2, 2, 6)) = Sheet1.Cells(i + j - 1, k + 1)
    
21.         Next k
    
22.             Set Pic = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Sheet1.Cells(i + j - 1, 7))
    
23.             Pic.ShapeRange.Left = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Left
    
24.             Pic.ShapeRange.Top = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Top
    
25.             Pic.ShapeRange.Width = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Width
    
26.             Pic.ShapeRange.Height = Cells(Int((j - 1) / 2) * 7 + 2, IIf(j Mod 2, 3, 7)).Height * 4
    
27.     Next j
    
28.     ActiveSheet.PrintOut
    
29. Next i
    
30. End Sub
    
31. 
    
32. Sub PAll()
    
33. Call PRwithPic(True)
    
34. End Sub
    
35. Sub Ppage()
    
36. Call PRwithPic(False)
    
37. End Sub

复制代码

无聊的疯子

夹竹桃 发表于 2012-9-25 21:59
大家好！是不是很难啊

   2、问题是“数据表”中的内容如何用函数公式完成？

你表里的什么内容要用函数公式来完成呢？？搞不明白

夹竹桃

suye1010版主
你好！如果能在1.jpg 2.jpg显示照片的位置显示照片  然后打印就更好了，烦你帮帮我。
首先谢谢你的辛苦！