Border with random colors

VBAbeginner · #1 09-12-2016, 05:37 AM

Hey,

I want to create a macro, which automatically creates a random colored border on every single page of the document. Random colors come from a set of 10 or so colors.

I can't manage to find an event for the creation of a new sheet, so this is my alternate plan:

- Button on page 1
- Macro for the button does:

-- Delete all rectangles in document
-- foreach page
--- create rectangle in 0,0 with 5cm width, 29,7cm height
--- set a random color from color set

Is there an easier way than deleting all existing rectangle shapes and adding one to each page?

Can anyone give me a snippet for the rectangle creation with the specific coords and for the creation of the color set and selection of a random color?

Thank you very much!

macropod · #2 09-12-2016, 05:05 PM

The only way you could have a separate colour for the border on each page using Word's page border tools would be by using 'next page' Section breaks between the pages so you can independently colour the border for each Section.

The alternative would be to overlay each page with a transparent rectangle, then colour the rectangle borders. There is no need to delete existing rectangles to change their colours.

Either approach, though, would make it difficult to manage future edits to the document.

Guessed · #3 09-12-2016, 08:13 PM

This code should get you started. It is relatively easy to delete all shapes from a document so you should be able to find examples online easily enough.

Code:

Sub AddRandomBorder()
  Dim aRng As Range, i As Integer, aPara As Paragraph, aShp As Shape
  Dim iWidth As Integer, iHeight As Integer
  
  With ActiveDocument.Sections(1).PageSetup
    iWidth = .PageWidth - 40
    iHeight = .PageHeight - 40
  End With
  
  For Each aPara In ActiveDocument.Paragraphs
    Set aRng = aPara.Range
    aRng.Collapse Direction:=wdCollapseStart
    If aRng.Information(wdActiveEndPageNumber) > i Then
      Set aShp = ActiveDocument.Shapes.AddShape(Type:=1, Left:=20, Top:=20, _
              Width:=iWidth, Height:=iHeight, Anchor:=aRng)
      With aShp
        .Line.ForeColor = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
        .Line.Weight = 3
        .Fill.Transparency = 1
      End With
      i = aRng.Information(wdActiveEndPageNumber)
    End If
  Next aPara
End Sub

VBAbeginner · #4 09-13-2016, 02:55 AM

Wow, thank you very much, my adaption of your snippet works great.

Do you have an idea of how to only delete these programmatically created rectangles, without touching other shapes in the document? Just for perfection, I'm already satisfied with the solution.

Guessed · #5 09-13-2016, 04:22 AM

I would use a way of tagging each of the border shapes when I put them in. That way it is much easier to identify the borders and kill them off. The normal (cheats

) way I go about tagging a shape is to use its alternative text property and hope that none of your other shapes has used the same thing. An example of doing it this way is...

Code:

Sub AddRandomBorder()
  Dim aRng As Range, i As Integer, aPara As Paragraph, aShp As Shape
  Dim iWidth As Integer, iHeight As Integer
  
  With ActiveDocument.Sections(1).PageSetup
    iWidth = .PageWidth - 40
    iHeight = .PageHeight - 40
  End With
  'Get rid of the existing borders
  For i = ActiveDocument.Shapes.Count To 1 Step -1
    If ActiveDocument.Shapes(i).AlternativeText = "Page Border" Then ActiveDocument.Shapes(i).Delete
  Next i
  
  For Each aPara In ActiveDocument.Paragraphs
    Set aRng = aPara.Range
    aRng.Collapse Direction:=wdCollapseStart
    If aRng.Information(wdActiveEndPageNumber) > i Then
      Set aShp = ActiveDocument.Shapes.AddShape(Type:=1, Left:=20, Top:=20, _
              Width:=iWidth, Height:=iHeight, Anchor:=aRng)
      With aShp
        .AlternativeText = "Page Border"
        .Line.ForeColor = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
        .Line.Weight = 3
        .Fill.Transparency = 1
      End With
      i = aRng.Information(wdActiveEndPageNumber)
    End If
  Next aPara
End Sub

macropod · #6 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Aligning Page Border with Table border without losing formatting :mad:	l39linden	Word Tables	5	10-04-2013 02:06 AM
Bar colors	ketanco	Project	1	03-30-2013 08:24 AM
Unable to change font colors from theme colors	choy	Word	3	08-01-2012 09:12 PM
random pop up wont go away	464646	OneNote	0	05-01-2012 04:34 AM
Only Random Border Lines Printing!	TheCatSpeaks	Excel	4	05-17-2010 07:39 AM