找回密码
 立即注册
搜索

VBA插入形状组合问题

0
回复
472
查看
[复制链接]

1

主题

8

帖子

25

幻币

江湖少侠

Rank: 2

积分
86
2018-11-28 23:49:22 显示全部楼层 |阅读模式
我写了一个宏,在ppt中插入几个形状并组合,宏如果连续执行就会出现问题,问题出现在组合的代码上,请帮忙看看是什么原因,十分感谢!
Public Sub 反应条件()
Dim MPoint_X, MPoint_Y As Long
Dim Num_shapes As Long
ScreenUpdating = False
MPoint_X = 400: MPoint_Y = 200
Num_shapes = ActiveWindow.Selection.SlideRange.Shapes.Count
ActiveWindow.Selection.SlideRange.Shapes.AddLine(MPoint_X - 40, MPoint_Y, MPoint_X + 40, MPoint_Y).Select
With ActiveWindow.Selection
.ShapeRange.Name = "shp" & Num_shapes + 1
.ShapeRange.Line.ForeColor.RGB = RGB(Red_N, Green_N, Blue_N)
.ShapeRange.Line.Weight = 1.5
End With
ActiveWindow.Selection.SlideRange.Shapes.AddLine(MPoint_X - 40, MPoint_Y + 5, MPoint_X + 40, MPoint_Y + 5).Select
With ActiveWindow.Selection
.ShapeRange.Name = "shp" & Num_shapes + 2
.ShapeRange.Line.ForeColor.RGB = RGB(Red_N, Green_N, Blue_N)
.ShapeRange.Line.Weight = 1.5
End With
ActiveWindow.Selection.SlideRange.Shapes.AddLine(MPoint_X - 10, MPoint_Y - 5, MPoint_X + 10, MPoint_Y - 5).Select
With ActiveWindow.Selection
.ShapeRange.Name = "shp" & Num_shapes + 3
.ShapeRange.Line.ForeColor.RGB = RGB(Red_N, Green_N, Blue_N)
.ShapeRange.Line.Weight = 1.5
End With
ActiveWindow.Selection.SlideRange.Shapes.AddLine(MPoint_X - 10, MPoint_Y - 5, MPoint_X, MPoint_Y - 25).Select
With ActiveWindow.Selection
.ShapeRange.Name = "shp" & Num_shapes + 4
.ShapeRange.Line.ForeColor.RGB = RGB(Red_N, Green_N, Blue_N)
.ShapeRange.Line.Weight = 1.5
End With
ActiveWindow.Selection.SlideRange.Shapes.AddLine(MPoint_X, MPoint_Y - 25, MPoint_X + 10, MPoint_Y - 5).Select
With ActiveWindow.Selection
.ShapeRange.Name = "shp" & Num_shapes + 5
.ShapeRange.Line.ForeColor.RGB = RGB(Red_N, Green_N, Blue_N)
.ShapeRange.Line.Weight = 1.5
End With
ActiveWindow.Selection.SlideRange.Shapes.Range(Array("shp" & Num_shapes + 1, "shp" & Num_shapes + 2, "shp" & Num_shapes + 3, "shp" & Num_shapes + 4, "shp" & Num_shapes + 5)).Select
ActiveWindow.Selection.ShapeRange.Group.Select
End Sub
PPT学习论坛
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册