Microsoft Office Forums - View Single Post

macropod · 09-13-2016, 04:54 AM

If you use code like:

Code:

Sub AddRandomBorder()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long, Shp As Shape, iWidth As Long, iHeight As Long
With ActiveDocument
  With .Sections(1).PageSetup
    iWidth = Int(.PageWidth - 40)
    iHeight = Int(.PageHeight - 40)
  End With
  For i = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
    Set Shp = .Shapes.AddShape(Type:=1, Top:=0, Left:=0, Width:=iWidth, _
      Height:=iHeight, Anchor:=Rng.GoTo(What:=wdGoToBookmark, Name:="\page"))
    With Shp
      .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
      .RelativeVerticalPosition = wdRelativeVerticalPositionPage
      .Top = 20
      .Left = 20
      .Line.ForeColor = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
      .Line.Weight = 3
      .Fill.Transparency = 1
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

which should execute somewhat more quickly on a large document, then, given that you know the sizes from the code that adds the shapes, you could delete them using code like:

Code:

Sub DelRandomBorders()
Application.ScreenUpdating = False
Dim i As Long, iWidth As Long, iHeight As Long
With ActiveDocument
  With .Sections(1).PageSetup
    iWidth = Int(.PageWidth - 40)
    iHeight = Int(.PageHeight - 40)
  End With
  For i = .Shapes.Count To 1 Step -1
    With .Shapes(i)
      If .Height = iHeight Then
        If .Width = iWidth Then .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub