Automatically selecting the images I just pasted 2

[Sendeman]

Hi All,

I'm trying to automate some routine work I have to do. I often have to copy-paste map images from Internet Explorer to Word and then resize/ position them. I have recorded and edited a macro that should do just what I want. Here's the code:

Sub PasteAndScaleMap()
'
' Paste and Scale Map from DINO database - Macro
' Macro recorded on 7-4-2006 by Martijn Senden
'
    Selection.PasteSpecial(Link:=False, DataType:= _
        wdPasteDeviceIndependentBitmap, Placement:=wdFloatOverText, DisplayAsIcon _
        :=False)
    'The next line is the problem!
    ActiveDocument.Shapes("Picture 549").Select
    'The previous line is the problem!
    Selection.ShapeRange.ZOrder msoSendToBack
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 242.1
    Selection.ShapeRange.Width = 239.55
    Selection.ShapeRange.PictureFormat.Brightness = 0.5
    Selection.ShapeRange.PictureFormat.Contrast = 0.5
    Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
    Selection.ShapeRange.PictureFormat.CropLeft = 0#
    Selection.ShapeRange.PictureFormat.CropRight = 0#
    Selection.ShapeRange.PictureFormat.CropTop = 0#
    Selection.ShapeRange.PictureFormat.CropBottom = 0#
    Selection.ShapeRange.RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
        wdRelativeVerticalPositionPage
    Selection.ShapeRange.Left = CentimetersToPoints(7.07)
    Selection.ShapeRange.Top = CentimetersToPoints(5.18)
    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 = wdWrapSquare
End Sub

I think I should somehow create a macro that doesn't select the map based on a specific name. I don't know the name Word is going to give to the pasted map. I can't think of a way to select the pasted map without using its name. Can anybody here help me out with this? It would be greatly appreciated.

Thanks in advance for any help.

Best regards,
Martijn Senden.

 

[Sendeman]

Hi, I still can't figure this out. Does anybody have an idea for this? Thanks again!

Best regards,
Martijn Senden.

I love deadlines. I like the whooshing sound they make as they fly by.
- Douglas Adams -

 

[fumei]

Use the .Count of the Shapes collection to get the last one. Comments:

1. you may want to consider eliminating stuff that you are not using. Do you really need to set all those parameters?

2. If this is going to be used for a number of images then be careful with your placement parameters. Obviously running the code again will simply place the image in the same location.

Sub PasteAndScaleMap()
Dim oShape As Word.Shape
    Selection.PasteSpecial Link:=False, DataType:=wdPasteDeviceIndependentBitmap, Placement:=wdFloatOverText, DisplayAsIcon:=False
[COLOR=red]' make a Shape object of the last Shape
' in the collection[/color red]
Set oShape = ActiveDocument.Shapes(ActiveDocument.Shapes.Count)

With oShape
    .ZOrder msoSendToBack
    .Fill.Visible = msoFalse
    .Fill.Transparency = 0#
    With .Line
        .Weight = 0.75
        .DashStyle = msoLineSolid
        .Style = msoLineSingle
        .Transparency = 0#
        .Visible = msoFalse
    End With
    .LockAspectRatio = msoTrue
    .Height = 242.1
    .Width = 239.55
    With .PictureFormat
        .Brightness = 0.5
        .Contrast = 0.5
        .ColorType = msoPictureAutomatic
        .CropLeft = 0#
        .CropRight = 0#
        .CropTop = 0#
        .CropBottom = 0#
    End With
    .RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    .RelativeVerticalPosition = _
        wdRelativeVerticalPositionPage
    .Left = CentimetersToPoints(7.07)
    .Top = CentimetersToPoints(5.18)
    .LockAnchor = False
    With .WrapFormat
        .AllowOverlap = True
        .Side = wdWrapBoth
        .DistanceTop = CentimetersToPoints(0)
        .DistanceBottom = CentimetersToPoints(0)
        .DistanceLeft = CentimetersToPoints(0.32)
        .DistanceRight = CentimetersToPoints(0.32)
        .Type = wdWrapSquare
    End With
End With
Set oShape = Nothing
End Sub

Gerry

 

[Sendeman]

Thanks, that did it! I'll have a look at what properties I will really have to set and which ones I can ditch. Thanks for you suggestions.

Best regards,
Martijn Senden.

I love deadlines. I like the whooshing sound they make as they fly by.
- Douglas Adams -