Results 1 to 5 of 5
  1. #1
    3 Star Lounger
    Join Date
    Jun 2009
    Location
    Hemet CA
    Posts
    310
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Talking

    Iím using Word2007 and I have a recorded macro that will insert an arrow into my repot that is a curtain size, color and style. The problem Iím having is when I run the macro it first bounces around the screen and then locates itself at the top of the page. How can I stop it from bouncing around and is it possible to have the arrow be inserted at location of curser.
    I also have the same problem with a circle that I use.
    Here is my macro for the arrow

    Code:
    Sub Macro2()
    '
    ' Macro2 Macro
    '
    '
    	ActiveDocument.Shapes.AddConnector(msoConnectorStraight, 436.5, 125.35, _
    		0.65, 31.5).Select
    	Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    	Selection.ShapeRange.Fill.Transparency = 0#
    	Selection.ShapeRange.Line.Weight = 1.75
    	Selection.ShapeRange.Line.DashStyle = msoLineSolid
    	Selection.ShapeRange.ConnectorFormat.Type = msoConnectorStraight
    	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.Line.BeginArrowheadLength = msoArrowheadLengthMedium
    	Selection.ShapeRange.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
    	Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
    	Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    	Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    	Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    	Selection.ShapeRange.LockAspectRatio = msoFalse
    	Selection.ShapeRange.Rotation = 0#
    	Selection.ShapeRange.Left = 436.3
    	Selection.ShapeRange.Top = 125.25
    	Selection.ShapeRange.RelativeHorizontalPosition = _
    		wdRelativeHorizontalPositionColumn
    	Selection.ShapeRange.RelativeVerticalPosition = _
    		wdRelativeVerticalPositionParagraph
    	Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
    	Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
    	Selection.ShapeRange.Left = InchesToPoints(0.11)
    	Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone
    	Selection.ShapeRange.Top = InchesToPoints(-0.01)
    	Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone
    	Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
    	Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
    	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

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    I don't think "cursor location" is meaningful when running a macro - the user could run the macro using the ribbon.

    The following version will create an arrow that starts at the insertion point in the document; it'll be 1" (72 points) high.

    Code:
    Sub Macro2()
      Dim x As Single
      Dim y As Single
      Const w = 0 ' points
      Const h = 72 ' points
      Application.ScreenUpdating = False
      x = Selection.Information(wdHorizontalPositionRelativeToPage)
      y = Selection.Information(wdVerticalPositionRelativeToPage)
      With ActiveDocument.Shapes.AddConnector(msoConnectorStraight, x, y, w, h)
    	.Line.EndArrowheadStyle = msoArrowheadTriangle
    	.Fill.Transparency = 0#
    	.Line.Weight = 1.75
    	.Line.DashStyle = msoLineSolid
    	.ConnectorFormat.Type = msoConnectorStraight
    	.Line.Style = msoLineSingle
    	.Line.Transparency = 0#
    	.Line.Visible = msoTrue
    	.Line.ForeColor.RGB = RGB(255, 0, 0)
    	.Line.BackColor.RGB = RGB(255, 255, 255)
    	.Line.EndArrowheadLength = msoArrowheadLengthMedium
    	.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    	.Line.EndArrowheadStyle = msoArrowheadTriangle
    	.LockAspectRatio = msoFalse
    	.WrapFormat.AllowOverlap = True
    	.WrapFormat.Side = wdWrapBoth
    	.WrapFormat.DistanceTop = InchesToPoints(0)
    	.WrapFormat.DistanceBottom = InchesToPoints(0)
    	.WrapFormat.DistanceLeft = InchesToPoints(0.13)
    	.WrapFormat.DistanceRight = InchesToPoints(0.13)
      End With
      Application.ScreenUpdating = True
    End Sub

  3. #3
    3 Star Lounger
    Join Date
    Jun 2009
    Location
    Hemet CA
    Posts
    310
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='HansV' post='783648' date='08-Jul-2009 13:52']I don't think "cursor location" is meaningful when running a macro - the user could run the macro using the ribbon.

    The following version will create an arrow that starts at the insertion point in the document; it'll be 1" (72 points) high.

    Code:
    Sub Macro2()
      Dim x As Single
      Dim y As Single
      Const w = 0 ' points
      Const h = 72 ' points
      Application.ScreenUpdating = False
      x = Selection.Information(wdHorizontalPositionRelativeToPage)
      y = Selection.Information(wdVerticalPositionRelativeToPage)
      With ActiveDocument.Shapes.AddConnector(msoConnectorStraight, x, y, w, h)
    	.Line.EndArrowheadStyle = msoArrowheadTriangle
    	.Fill.Transparency = 0#
    	.Line.Weight = 1.75
    	.Line.DashStyle = msoLineSolid
    	.ConnectorFormat.Type = msoConnectorStraight
    	.Line.Style = msoLineSingle
    	.Line.Transparency = 0#
    	.Line.Visible = msoTrue
    	.Line.ForeColor.RGB = RGB(255, 0, 0)
    	.Line.BackColor.RGB = RGB(255, 255, 255)
    	.Line.EndArrowheadLength = msoArrowheadLengthMedium
    	.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    	.Line.EndArrowheadStyle = msoArrowheadTriangle
    	.LockAspectRatio = msoFalse
    	.WrapFormat.AllowOverlap = True
    	.WrapFormat.Side = wdWrapBoth
    	.WrapFormat.DistanceTop = InchesToPoints(0)
    	.WrapFormat.DistanceBottom = InchesToPoints(0)
    	.WrapFormat.DistanceLeft = InchesToPoints(0.13)
    	.WrapFormat.DistanceRight = InchesToPoints(0.13)
      End With
      Application.ScreenUpdating = True
    End Sub
    [/quote]
    Hi HansV
    Thank you it works great, I also have a Red circle. that does the same as the arrow use tooooooo.
    here is the macro

    Code:
    Sub Macro1()
    '
    ' Macro1 Macro
    '
    '
    	ActiveDocument.Shapes.AddShape(msoShapeOval, 441#, 131.8, 36.65, 28.9) _
    		.Select
    	Selection.ShapeRange.Fill.Visible = msoTrue
    	Selection.ShapeRange.Fill.Solid
    	Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
    	Selection.ShapeRange.Fill.Transparency = 1#
    	Selection.ShapeRange.Line.Weight = 1.75
    	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 = 441.35
    	Selection.ShapeRange.Top = 131.75
    	Selection.ShapeRange.RelativeHorizontalPosition = _
    		wdRelativeHorizontalPositionColumn
    	Selection.ShapeRange.RelativeVerticalPosition = _
    		wdRelativeVerticalPositionParagraph
    	Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
    	Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
    	Selection.ShapeRange.Left = InchesToPoints(0.18)
    	Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone
    	Selection.ShapeRange.Top = InchesToPoints(0.08)
    	Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone
    	Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
    	Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
    	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

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    If you take a look at the differences between your original arrow macro and the version that I posted, you should be able to work out how to modify the circle macro.

  5. #5
    3 Star Lounger
    Join Date
    Jun 2009
    Location
    Hemet CA
    Posts
    310
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='HansV' post='783724' date='08-Jul-2009 22:41']If you take a look at the differences between your original arrow macro and the version that I posted, you should be able to work out how to modify the circle macro.[/quote]
    Hi HansV
    I thank you for this lesson with macro's
    I did as you mentioned and here's what I came up with.....
    I made some changes to the size
    Thank you again that was cool

    Code:
    Sub Macro1()
    Dim x As Single
      Dim y As Single
      Const w = 50 ' points
      Const h = 50 ' points
      Application.ScreenUpdating = False
      x = Selection.Information(wdHorizontalPositionRelativeToPage)
      y = Selection.Information(wdVerticalPositionRelativeToPage)
      With ActiveDocument.Shapes.AddShape(msoShapeOval, x, y, w, h)
    	.Fill.Visible = msoTrue
    	.Fill.Solid
    	.Fill.ForeColor.RGB = RGB(255, 255, 255)
    	.Fill.Transparency = 1#
    	.Line.Weight = 1.75
    	.Line.DashStyle = msoLineSolid
    	.Line.Style = msoLineSingle
    	.Line.Transparency = 0#
    	.Line.Visible = msoTrue
    	.Line.ForeColor.RGB = RGB(255, 0, 0)
    	.Line.BackColor.RGB = RGB(255, 255, 255)
    	.LockAspectRatio = msoFalse
    	.WrapFormat.AllowOverlap = True
    	.WrapFormat.Side = wdWrapBoth
    	.WrapFormat.DistanceTop = InchesToPoints(0)
    	.WrapFormat.DistanceBottom = InchesToPoints(0)
    	.WrapFormat.DistanceLeft = InchesToPoints(0.13)
    	.WrapFormat.DistanceRight = InchesToPoints(0.13)
    End With
      Application.ScreenUpdating = True
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •