在ppt文件中每页slide右上角生成一个宽200高200的矩形框

Sub AddRectangleToSlides()
    Dim sld As Slide
    Dim shp As Shape
    
    For Each sld In ActivePresentation.Slides
        Set shp = sld.Shapes.AddShape(msoShapeRectangle, 500, 20, 200, 200)
        shp.Line.Visible = msoFalse '隐藏边框线
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255) '设置填充颜色为白色
        
        '将矩形框移动到右上角位置
        shp.Left = sld.Master.Width - (shp.Width + 20)
        
        If Not IsNull(shp.Top) Then
            shp.Top = 20
        End If
        
    Next sld
    
End Sub

猜你喜欢

转载自blog.csdn.net/dgwxligg/article/details/129373335