Office教程学习网

昨天碰巧想用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