昨天碰巧想用VBA解决一个问题,因为下载laose发过的那个“图片分割”工具,总是有问题(不知道是不是电脑的问题)!于是想着自己弄个小程序,一个函数就搞定了!它不用安装,不用设置参考线,不用手动调节,只需运行一下宏,就可轻松搞定各种形状样式的分割!
操作步骤
新建幻灯片,打开开发工具,VBA的编辑区,插入一个模块,将我上传的文件中的全部代码,见第8步,拷贝粘贴!怕麻烦的朋友,也可以直接在我的上传的样例中,新建一个幻灯片作为练习,这样就不用拷贝代码了!
选择版式空白,如下图
设置背景格式,选择你要分割的图片,填充背景
添加一个形状,你想将图片分割成什么形状,就添加什么形状!什么形状都可以!比如我们来个圆角矩形!形状的大小,你自己说的算!
为形状添加一个动作,在插入——动作——单击鼠标——运行宏:选择默认函数(GetShapeCUT)
放映幻灯片,单击该形状,程序即在后台运行,当弹出“转换完毕”的字样后,则退出放映模式,因为图片已经分割完成了!
因为是以幻灯片的背景做为填充,可能你还看不出来变化,接下来就是见证奇迹的时刻了:添加一个和幻灯片一样大的矩形,并置于底层!你看到了吗?
背景你可以改变的,这些形状也是可以改变的,你懂的,anything is possible!
程序代码
Dim W As Long
Dim H As Long
Sub GetWH()
W = Application.ActivePresentation.PageSetup.SlideWidth
H = Application.ActivePresentation.PageSetup.SlideHeight
End Sub
Sub GetShapeCUT(shp As shape)
Dim wShape As Long
Dim hShape As Long
Dim i, j, n As Integer
Dim WNum As Integer
Dim HNum As Integer
wShape = shp.Width
hShape = shp.Height
Call GetWH
i = W Mod wShape
j = H Mod hShape
If i <> 0 Then
WNum = W \ wShape + 1
Else
WNum = W \ wShape
End If
If j <> 0 Then
HNum = H \ hShape + 1
Else
HNum = H \ hShape
End If
n = 1
For i = 0 To HNum - 1
For j = 0 To WNum - 1
With shp.Duplicate
.Left = j * wShape
.Top = i * hShape
.Name = "N" + CStr(n)
.Fill.Background
.Line.Transparency = 1
n = n + 1
End With
Next
Next
shp.Visible = msoFalse
MsgBox "转换完毕"
End Sub |