Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Word 2003 create elipise macro can't set fill to none 2

Status
Not open for further replies.

DougP

MIS
Dec 13, 1999
5,985
US
I make a lot of instruction sheets using screen captures and directions in Word, so I use a lot of "red" elipses. (easy to see)
I created a macro to put in an elipse, changed the line thickness and the line color and the fill color to none.
But when I run the macro it does eveything but change the fill to none. I have to right click it and then pick colors and lines tab and set fill to none again everytime.
I even tried making a macro to redo it but I can't seem to spot the fill thingy in the VBA code.
any ideas?

Code:
Sub RedElipse()
'
' RedElipse Macro
' Macro recorded 1/13/2011 by xxxx
'
    ActiveDocument.Shapes.AddShape(msoShapeOval, 198#, 153#, 54#, 27#) _
        .Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 1.5
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.Left = 198#
    Selection.ShapeRange.Top = 153.35
    Selection.ShapeRange.RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
        wdRelativeVerticalPositionParagraph
    Selection.ShapeRange.Left = InchesToPoints(1.5)
    Selection.ShapeRange.Top = InchesToPoints(1.13)
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.LayoutInCell = True
    Selection.ShapeRange.WrapFormat.AllowOverlap = True
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = InchesToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceBottom = InchesToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceLeft = InchesToPoints(0.13)
    Selection.ShapeRange.WrapFormat.DistanceRight = InchesToPoints(0.13)
    Selection.ShapeRange.WrapFormat.Type = 3
    Selection.ShapeRange.ZOrder 4
End Sub

TIA

DougP
 


Change the Fill Transparency to 1...
Code:
    Selection.ShapeRange.Fill.Transparency = 1


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks a million Skip.

here is another one for you...
obviously it put 'sthe elipse in the exact same place on whatever page I'm on. How can I pick a point on the screen first and have it start there?

DougP
 
As is, you can't. You are setting a Shape, and it therefore has an anchor. The anchor is on the graphics layer. It can be moved about.

A point on the page is on the text layer, and can NOT be moved about. Two different beasties.

< 60 50 40 working days until retirement; with 87 accumulated sicks days. Know what? I am not feeling well.
 
I shall correct myself. Try:
Code:
Sub OtherWay()
Dim jHoriz As Long
Dim kVert As Long
Dim oShape As Shape
jHoriz = Selection.Information(wdHorizontalPositionRelativeToPage)
kVert = Selection.Information(wdVerticalPositionRelativeToPage)
Set oShape = ActiveDocument.Shapes.AddShape(msoShapeOval, jHoriz - 35, kVert, 70, 27)

With oShape
   With .Fill
      .Visible = msoFalse
      .Solid
      .Transparency = 1
   End With
   With .Line
      .Weight = 1.5
      .DashStyle = msoLineSolid
      .Style = msoLineSingle
      .Transparency = 0#
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .BackColor.RGB = RGB(255, 255, 255)
   End With
   .LockAspectRatio = msoFalse
   .Rotation = 0#
   .LockAnchor = False
   .LayoutInCell = True
   With .WrapFormat
      .AllowOverlap = True
      .Side = wdWrapBoth
      .DistanceTop = InchesToPoints(0)
      .DistanceBottom = InchesToPoints(0)
      .DistanceLeft = InchesToPoints(0.13)
      .DistanceRight = InchesToPoints(0.13)
      .Type = 3
   End With
   .ZOrder 4
End With
This takes the relative position of the Selection (the cursor location), and uses those numbers to place the Shape. As it is an oval, the horizontal offset (to try and get the oval center at the Selection) = 1/2 the horizontal dimension of the Shape (70/2).

It is not perfect, but Word is not a layout application (as much as Microsoft tries to pretend it is).

Notes:

1. the Shape is still a Shape and can be moved, or tweaked.

2. if the Selection is not collapsed (to a point), the placement may be wonky. You could either collapse it first{code]
Dim jHoriz As Long
Dim kVert As Long
Dim oShape As Shape
Selection.Collapse 1
jHoriz = Selection.Information(wdHorizontalPositionRelativeToPage)
kVert = Selection.Information(wdVerticalPositionRelativeToPage)
[/code]
OR, with MUCH fussing, try to determine the horizontal dimension from th elength of the Selection. The problem with this is that the Shape dimension numbers are hard, and the Selection length (using Len) is a character count, and the text is kerned. Can it be done? Yes, but takes fussing. Not worth it, IMO.

< 60 50 40 working days until retirement; with 87 accumulated sicks days. Know what? I am not feeling well.
 


Hear, hear! Give THAT man a purple star!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top