PDA

View Full Version : [SOLVED:] Macro for setting one style of all pictures



witia1990
01-29-2020, 12:59 PM
I am a beginner in VBA. However, I have some programming experience.
I have a .docx file in which there is around 90 pictures. Unfortunately, those pictures have different styles.
I would like to write a macro in which I will go through all the pictures in a file and set their style into a specific one that I created in word. Let's call it "picture" style.

I wrote some part of code but VBA gives me an error which I do not understand.

Here is the code:


Sub ChangeStylePicture()
Dim i As Integer

For i = 1 To InlineShapes.Count
If InlineShapes.Item(i).Type = wdInlineShapePicture Then
InlineShapes.Item(i).Style = ActiveDocument.Styles("Picture")
End If
Next i
End Sub


VBA tells me that there is no variable defined in the loop, which I do not understand.

I will be very grateful for any tip how to deal with this problem or how to correct the code.

gmaxey
01-29-2020, 02:24 PM
I could be wrong, but I've been around Word a long time and I don't know of a .Style attribute for a picture. Your first error is because InlineShapes is a collection of the document.range object not the application object.

Select your picture with the "style" you like and run this:


Sub CopySelectedFormattingToRest()
Dim oILS As InlineShape
Dim lngWidth As Long, lngHeight As Long
Dim bPaint As Boolean
Dim oILSelected As InlineShape
Dim bSelectedPortrait As Boolean
Dim bFixAspect As Boolean

bPaint = False
If Selection.InlineShapes.Count = 1 Then
bPaint = True
Set oILSelected = Selection.InlineShapes(1)
lngHeight = oILSelected.Height
lngWidth = oILSelected.Width
If lngHeight > lngWidth Then bSelectedPortrait = True
With ActiveDocument.Range
For Each oILS In .InlineShapes
If oILS.Range.Start <> oILSelected.Range.Start Then
Select Case bSelectedPortrait
Case True
With oILS
If .Height > .Width Then
'This one is portrait too
PaintPictureFormat oILSelected, oILS
.LockAspectRatio = msoTrue
.Height = lngHeight
Else
PaintPictureFormat oILSelected, oILS
.LockAspectRatio = msoTrue
.Height = lngWidth
End If
End With
Case Else
With oILS
If .Width > .Height Then
'This one is landscape too
PaintPictureFormat oILSelected, oILS
.LockAspectRatio = msoTrue
.Height = lngHeight
Else
PaintPictureFormat oILSelected, oILS
.LockAspectRatio = msoTrue
.Height = lngWidth
End If
End With
End Select
End If
DoEvents
Application.ScreenRefresh
DoEvents
Next
End With
End If
lbl_Exit:
Exit Sub
End Sub

Sub PaintPictureFormat(ByRef oILS1 As InlineShape, oILS2 As InlineShape)
Dim lngPE As Long, lngParam As Long
'Select the reference inlineshape and copy formatting. This grabs most of the attributes (e.g., border, shadow, soften, etc.)
oILS1.Select
Selection.CopyFormat
'Select the target inlineshape and apply the formatting
oILS2.Select
Selection.PasteFormat
On Error Resume Next
'Clear all picture effects in the target shape.
For lngPE = oILS2.Fill.PictureEffects.Count To 1 Step -1
oILS2.Fill.PictureEffects.Item(lngPE).Delete
Next lngPE
'Apply picture effects of source ILS to target ILS
For lngPE = 1 To oILS1.Fill.PictureEffects.Count
'Insert the effect.
oILS2.Fill.PictureEffects.Insert oILS1.Fill.PictureEffects.Item(lngPE)
'Apply the effect parameters.
For lngParam = 1 To oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters.Count
Debug.Print oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Name & " " & oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Value
oILS2.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Value = oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Value
Debug.Print oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Name & " " & oILS1.Fill.PictureEffects.Item(lngPE).EffectParameters(lngParam).Value
Next lngParam
Next lngPE
On Error GoTo 0
lbl_Exit:
Exit Sub
End Sub

witia1990
01-30-2020, 01:29 AM
Thank You for your answer.

I made a little research and I have my final code.
Note that I am considering only inline images (without floatin images)


Sub ChangeStylePicture()

Dim Image As InlineShape
Dim Shp As Shape

For Each Image In ActiveDocument.InlineShapes
'We do it for inline images
If Image.Type = wdInlineShapePicture Then
Image.Select
Selection.Style = ActiveDocument.Styles("Picture")
End If
Next
End Sub

macropod
01-30-2020, 04:22 AM
Your 'Picture' Style has nothing to do with the picture itself; it is evidently a paragraph Style. As Greg correctly observed, there is no such thing as a Style attribute for pictures.

In any event, Selecting content in code is very inefficient. Try:

Sub ApplyPictureStyle()
Application.ScreenUpdating = False
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Type = wdInlineShapePicture Then .Range.Style = "Picture"
End With
Next
Application.ScreenUpdating = True
End Sub

witia1990
01-30-2020, 05:49 AM
Thank you very much for your code and remark.

gmaxey
01-30-2020, 06:18 AM
What specifically are you trying to do with this "Picture" style. As has been pointed out to you twice, a style has not effect on an image.

witia1990
01-30-2020, 06:38 AM
I have a document in which pictures are the only element in a paragraph (as you properly mentioned) and they have a specific style.
It looks like this.

25896

So each picture that has caption below is in its own paragraph and has specific style "picture".

The only problematic case is when there are some small pictures among the text, i.e., inside a paragraph. In this case I want to leave this inserted picture untouched.

I hope that I explained things clearly.

macropod
01-30-2020, 02:37 PM
What specifically are you trying to do with this "Picture" style. As has been pointed out to you twice, a style has not effect on an image.
If it's an inline-shape, a paragraph Style can affect the image alignment (e.g. centring it on the page).

gmaxey
01-30-2020, 03:37 PM
Paul,

He is applying the style to the selection paragraph, not the selected image. If there is one character "X" in front of the image and twenty after "XXXXXXXXXXXXXXXXXXXX" the image will not be centered.

macropod
01-30-2020, 03:46 PM
I am fully aware of that possibility - but that's not what the image in post #7 depicts and, even if it were, the appropriate setting of left & right indents (e.g. such that they set the paragraph width to the picture width) would address that.

gmaxey
01-30-2020, 04:03 PM
Paul,

The horse is dead I think. He choked on the fact that inlineshape objects don't have a style method as proved when/if you try to run or compile:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oIls As InlineShape
On Error Resume Next
Set oIls = ActiveDocument.InlineShapes(1)
On Error GoTo 0
If Not oIls Is Nothing Then
oIls.Style = "Picture"
End If
lbl_Exit:
Exit Sub
End Sub


However, it does have a range and that range has a paragraph.



Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey
Dim oIls As InlineShape
On Error Resume Next
Set oIls = ActiveDocument.InlineShapes(1)
On Error GoTo 0
If Not oIls Is Nothing Then
oIls.Range.Paragraphs(1).Style = "Picture"
End If
lbl_Exit:
Exit Sub
End Sub

macropod
01-30-2020, 06:13 PM
I'd have thought all that was perfectly obvious from the code I posted...

witia1990
01-31-2020, 01:22 AM
Greg and Paul,
Thank You very much for your interest in my problem. Here is my case once again.

25901

I know how to write my code for inline pictures but floating pictures are problematic.

Do You have any idea how to put in a code a conditional instruction in which I will check whether an inline picture is not a floating picture?

I have tried the code for floating pictures (msoPicture in shapes class - I suppose. I found the info https://software-solutions-online.com/word-vba-loop-through-images/).

My Code:

Sub ApplyPictureStyle1()
Application.ScreenUpdating = False
Dim Shp As Shape
For Each Shp In ActiveDocument.Shapes
With Shp
If .Type = msoPicture Then .Range.Style = "Picture"
End With
Next
Application.ScreenUpdating = True
End Sub
The problem is with Range method on shape class element.
Do You have any idea what to do?


(https://software-solutions-online.com/word-vba-loop-through-images/)

macropod
01-31-2020, 03:10 AM
Shape objects don't have a Range, so you can't apply a Style to them. You could apply a Style to their Anchor, but that wouldn't be of any use; in fact, it'd likely do more harm than good. Instead, you need to apply the required attributes to the shape's properties. For example:

Sub ApplyShapeAlignment()
Application.ScreenUpdating = False
Dim Shp As Shape
For Each Shp In ActiveDocument.Shapes
With Shp
If .Type = msoPicture Then
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.Left = wdShapeCenter
End If
End With
Next
Application.ScreenUpdating = True
End Sub

macropod
02-01-2020, 11:02 PM
Now cross-posted at: https://stackoverflow.com/questions/60013961/change-a-style-of-a-paragraph-with-picture without the courtesy of even acknowledging the answer already supplied here.
Kindly read VBA Express' policy on Cross-Posting in Rule 3 - one of the rules you agreed to abide by when you joined this forum - at: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

witia1990
02-02-2020, 01:23 AM
Paul,

I am very sorry for this misunderstanding. To be honest, I didn' t know that there is such a rule.
I am grateful for your help and I will remember not to make the same mistake in the future.