DRAFT Macro 1

[bont]

I want to create a macro that would cycle through each page of a MS Word Document, and apply some sort of stamp of the word DRAFT in the middle of the page. Does anyone have an easy way of doing this. I like the effect of using a text box, but I can't record a macro to figure out how to do this via script. Another problem is that I can't get the word "DRAFT" to slant as I would like it to, so then I am thinking of adding a picture.

Any suggestions?

 

[dyarwood]

Could you use a wordart box

The code is

ActiveDocument.Shapes.AddTextEffect(msoTextEffect27, "DRAFT", "Impact", _
36#, msoFalse, msoFalse, 261.75, 165.85).Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.Left = 261.6
Selection.ShapeRange.Top = 165.8
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.BackColor.RGB = RGB(112, 112, 112)
Selection.ShapeRange.Fill.TwoColorGradient msoGradientDiagonalUp, 4
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Left = CentimetersToPoints(2.06)
Selection.ShapeRange.Top = CentimetersToPoints(0.32)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 5

Think this will produce a word art and then set it behind the text

dyarwood

 

[SQLBI]

A slight ehancement to dyarwood's code would be thus:

ActiveDocument.Shapes.AddTextEffect(msoTextEffect27, "DRAFT", "Impact", _
        36#, msoFalse, msoFalse, 261.75, 165.85).Select
With Selection.ShapeRange
    .Fill.Transparency = 0#
    .LockAspectRatio = msoFalse
    .Rotation = 0#
    .Left = 261.6
    .Top = 165.8
    .Fill.Visible = msoTrue
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.BackColor.RGB = RGB(112, 112, 112)
    .Fill.TwoColorGradient msoGradientDiagonalUp, 4
    .RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    .RelativeVerticalPosition = _
        wdRelativeVerticalPositionParagraph
    .Left = CentimetersToPoints(2.06)
    .Top = CentimetersToPoints(0.32)
    .LockAnchor = False
    .WrapFormat.AllowOverlap = True
    .WrapFormat.Side = wdWrapBoth
    .WrapFormat.DistanceTop = CentimetersToPoints(0)
    .WrapFormat.DistanceBottom = CentimetersToPoints(0)
    .WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
    .WrapFormat.DistanceRight = CentimetersToPoints(0.32)
    .WrapFormat.Type = 3
    .ZOrder 5
End With

By referencing "

Selection.ShapeRange

" each time you slow down your code considerably, but by using the

With

declaration, things should run quicker.

Hope this helps.


Leigh Moore
Solutions 4 MS Office Ltd

http://www.solutions4msoffice.co.uk

 

[dyarwood]

I always forget those with statements. Well pointed out leighmoore

 

[SQLBI]

I've only just discovered how useful they are and even with 2 object methods try to use With all the time, it's a good habit to get into.

With this example you could take it even further...

ActiveDocument.Shapes.AddTextEffect(msoTextEffect27, "DRAFT", "Impact", _
        36#, msoFalse, msoFalse, 261.75, 165.85).Select
With Selection.ShapeRange
    .Fill.Transparency = 0#
    .LockAspectRatio = msoFalse
    .Rotation = 0#
    .Left = 261.6
    .Top = 165.8
    With .Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .BackColor.RGB = RGB(112, 112, 112)
        .TwoColorGradient msoGradientDiagonalUp, 4
    End With
    .RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    .RelativeVerticalPosition = _
        wdRelativeVerticalPositionParagraph
    .Left = CentimetersToPoints(2.06)
    .Top = CentimetersToPoints(0.32)
    .LockAnchor = False
    With .WrapFormat
        .AllowOverlap = True
        .Side = wdWrapBoth
        .DistanceTop = CentimetersToPoints(0)
        .DistanceBottom = CentimetersToPoints(0)
        .DistanceLeft = CentimetersToPoints(0.32)
        .DistanceRight = CentimetersToPoints(0.32)
        .Type = 3
    End With
    .ZOrder 5
End With

It all adds up to more efficient code.




Leigh Moore
Solutions 4 MS Office Ltd

http://www.solutions4msoffice.co.uk