VBA macro for Word (a selected picture editing)

[Romulus]

Hello all,
I need your help, for you this is for sure a walk in a park, but for me it is not :banghead: . I have got a Word 2000 file, a report in which I insert various pictures. Document is quite long (up to 60 pages) and number of pictures is also significant, up to 40 pictures. To avoid having a huge file in the end (~ 30 MB), I need to edit each picture, taking following steps:

A). Select the picture, CTRL + X;
B). Paste Special – Picture;
C). Select the picture, CTRL + X, Paste Special, Picture (JPEG);
D). Picture cropping on right hand side (5.25 units) + picture cropping on bottom side (2.65 units);
E). Select the picture, then Text Wrapping, Top and bottom;
F). Save the document.
I have tried to solve it, by recording a macro, the issue is that it stops after step B. I guess it stops because right after step B picture is not anymore selected, therefore the routine stops.

Here is the code I have got:
Sub JPEGs()
'
' JPEGs Macro

Selection.Cut
Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdFloatOverText, DisplayAsIcon:=False
Selection.Cut
Selection.PasteSpecial Link:=False, DataType:=15, Placement:= _
wdFloatOverText, DisplayAsIcon:=False
Selection.ShapeRange.PictureFormat.CropRight = 5.25
Selection.ShapeRange.PictureFormat.CropBottom = 2.65
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
ActiveDocument.Save
End Sub

When I run it, it just stops on second “Selection.Cut” (marked in red), error generated is: Run-time error ‘4605’. This method or property is not available because the object is empty.

Could you please help me to make it work ?

Or, is there any other solution, to avoid having huge Word 2000 files, after inserting many, many pictures ?

Please note that I do not want this macro to apply these steps/editing to all pictures intersted into the file, I just want it to apply the changes to the picture I select, nothing else. Thank you in advance and have a nice day.

Romulus.

[TonyJollans]

When you paste as wdFloatOverText, the pasted picture is in the drawing layer and not in the selection. It does, though, have an anchor in the selection's paragraph, so - provided you only have no pictures anchored to that paragraph to begin with - you should be able to re-select it with:

Selection.Paragraphs(1).Range.ShapeRange(1).Select

(if you do have other pictures it is more complicated because you don't know which picture is which)

[Romulus]

Hello Tony,

Thank you for your reply and sorry for getting back to you so late.

Your assumption is correct, Word 2000 file I work on contains a certain number of pictures already inserted. To have my problem solved correctly and completely, VBA routine must start editing the picture I select (which is first part of step A, see below), then to continue to take all the steps, till the last one (step I), without any other intervention from the user. It means, VBA code must be able to detect which was the picture on which step A and step B were applied, and after this detection, to select it and complete the other steps, from C to I. I guess this is not too easy.

Can you help me to solve this problem :help ? Thank you once again and have a great day.

My best regards,
Romulus.

[TonyJollans]

Sorry for the long delay - I have been away.

This is really rather awkward. Without a lot of analysis, you really can't locate the pasted picture if there are other shapes.

One way round this is to add an empty paragraph to the document and to paste to that - you would then know that the pasted picture was the only shape in that paragraph. When you have done whatever with the picture you could move it where you want it to be (your code doesn't show this) and delete the temporary paragraph. A bit messy, but it should work ...

Start something like this (note that this also remembers some settings):

Dim Temp As Range, Original As Range
Dim Top As Long, Left As Long

Set Temp = Selection.Paragraphs.Add(Selection.Paragraphs(1).Range).Range
Set Original = Selection.Paragraphs(1).Range

Temp.Collapse wdCollapseStart
Original.Collapse wdCollapseStart

Selection.Cut
Temp.PasteSpecial Link:=False, dataType:=wdPasteMetafilePicture, _
Placement:=wdFloatOverText, DisplayAsIcon:=False
Temp.Paragraphs(1).Range.ShapeRange(1).Select

Top = Selection.ShapeRange(1).Top
Left = Selection.ShapeRange(1).Left

You then have another cut and paste that I don't understand - ignoring that, you then adjust some picture settings that seem to force the it to move. This code restores the original paste position, after which I think you then need to cut and paste it again - to the original paragraph, and delete the one you created.

Selection.ShapeRange.PictureFormat.CropRight = 5.25
Selection.ShapeRange.PictureFormat.CropBottom = 2.65
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom

Selection.ShapeRange(1).Top = Top
Selection.ShapeRange(1).Left = Left
Selection.Cut
Original.Paste

Temp.Delete
ActiveDocument.Save

This isn't really brilliant code, and it could be tidied up, but maybe it will point you in a direction that might work, probably after some trial and error.