图片拆分工具源代码，配合以前发布的拼图游戏使用！！！

xiamen168

发布配合【泡妞神器来啦，excel拼图！】使用的图片拆分源代码
http://club.excelhome.net/thread-1145437-1-1.html

注意
1.本工具需在excel2003版本下使用，其他版本切割出来的图片有问题
2.原图片大小建议用600x400，把图片切割为6x6
3.把每个小图片重新分配宏 sub picxx_click()
4.请有时间的朋友做个更加自动的工具

1. Sub 拆分()
   
2.     Dim 原图 As Object
   
3.     Dim 多图 As Shape
   
4.    
   
5.     Dim i As Integer
   
6.     Dim j As Integer
   
7.     Dim num As Integer
   
8.     Dim myFname As String
   
9.    
   
10.     Dim 原图宽 As Single, 原图高 As Single
    
11.     Dim 拆分宽 As Single, 拆分高 As Single
    
12.    
    
13.     Const 间隙 As Integer = 5
    
14.     Dim 横拆分数 As Integer, 纵拆分数 As Integer
    
15. 
    
16.     myFname = Application.GetOpenFilename(FileFilter:="全部图片(*.jpg),*.jpg")
    
17.    
    
18.     If myFname = "False" Then Exit Sub
    
19.    
    
20.     Set 原图 = ActiveSheet.Pictures.Insert(myFname)
    
21.    
    
22.     With 原图
    
23.         .Top = 5
    
24.         .Left = 5
    
25.     End With
    
26.    
    
27.     横拆分数 = Application.InputBox("横向要怎样拆分?", "请输入0以外的值")
    
28.     纵拆分数 = Application.InputBox("纵向要怎样拆分?", "请输入0以外的值")
    
29.    
    
30.     原图宽 = 原图.Width
    
31.     原图高 = 原图.Height
    
32.     拆分宽 = 原图宽 / 横拆分数
    
33.     拆分高 = 原图高 / 纵拆分数
    
34.     原图.Copy
    
35.     num = 1
    
36.    
    
37.     For i = 1 To 纵拆分数
    
38.         For j = 1 To 横拆分数
    
39.             ActiveSheet.Paste
    
40.             Selection.Name = "pic & num
    
41.             With ActiveSheet.Shapes("pic" & num)
    
42.                 .Top = 间隙 * i
    
43.                 .Left = 间隙 * j
    
44.                 With .PictureFormat
    
45.                     .CropTop = 拆分高 * (i - 1)
    
46.                     .CropBottom = 拆分高 * (纵拆分数 - i)
    
47.                     .CropLeft = 拆分宽 * (j - 1)
    
48.                     .CropRight = 拆分宽 * (横拆分数 - j)
    
49.                 End With
    
50.             End With
    
51.             num = num + 1
    
52.         Next
    
53.     Next
    
54.     原图.Delete
    
55.    
    
56. End Sub
    

复制代码

该贴已经同步到 xiamen168的微博

f8b1987

调用过程有错误

xiamen168

f8b1987 发表于 2014-9-15 13:16
调用过程有错误

2003肯定没问题