#1
|
|||
|
|||
Border with random colors
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! |
#2
|
||||
|
||||
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.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#4
|
|||
|
|||
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. |
#5
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
||||
|
||||
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 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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
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 |