Solved: picture style word 2010

[r_know]

Dear All,

I want to VBA Macros code inserted for Picture Style; here as backgrounds I have different pictures in table column, which I autofited by below macros.

But I want picture format should be apply for all, "Rounded diagonal corner , White".

How I can modified below code.

Picture Style:- http://blogs.office.com/b/microsoft-word/archive/2008/07/11/30-000-words.aspx




Sub Demo() Dim iShp As InlineShape
With ActiveDocument For Each iShp In InlineShapes If iShp.Range.Information(wdWithInTable) = True Then With iShp .LockAspectRatio = True .Width = .Range.Cells(1).Column.Width End With End If Next End With End Sub



Regards,
RL

[r_know]

Any reply to thread...

[fumei]

Have you tried recording a macro. What have you tried?

[r_know]

I tried, but no succeed..
Reason, macro does not show any code when I change style of current picture.

[r_know]

Anyone has suggestions....

[gmaxey]

Sometims the MS developers use a little magic dust and as far as I can tell there isn't a way to directly set the named picture styles from VBA or easily capture all the attributes of a given picture. All I can suggest is that could insert and format a picture with a style and one without and then view and compare the properties of each in the VBE locals or watch window.

There are a lot of properties, and a rounded corners doesn't jump out, but you can mimic many of the style attritbutes by matching attributes like "Borders, Fill, Glow, Picture Format, Reflection, Shadow, SoftEdge, and Offsets. Several of these properties have children properties of their own so if solution is there is may be buried several layers deep.

For example, this mimics the "simple frame black" style.

With ThisDocument.InlineShapes(1)
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth300pt
With .Shadow
.Blur = 4
.OffsetX = 2.12132
.OffsetY = 2.12132
.Style = msoShadowStyleOuterShadow
.Transparency = 0.57
.Visible = msoTrue
End With
End With


Good luck and if you find the right mixture of these properties, post back and let us know.

[r_know]

Thanks gmaxey,

I applied the given code but no effect any to change Picture Style in Document.

Can you suggest further!!@!!

[gmaxey]

Like I said, unless you can compare and match every atttribute with the formatted picture and apply it to a new picture and get the desired result, then I don't know if it can be done. I looked briefly and didn't see anything in the available attributes that would apply the two rounded corners.

[r_know]

Dear Greg,

Definitely, I am searching if found will be posted here.

Regards,
RL

[gmaxey]

Ok, the key seems to be first converting the inline shape to a shape and apply a autoshape format to the frame:

Option Explicit
Public Sub AddSnippedDiagonalCornerWhite()
Dim WdInlineShape As InlineShape
Dim WdShape As Shape
Set WdInlineShape = ActiveDocument.InlineShapes(1)

'Convert to shape. I could be wrong, but this seems to be the only way to get the snipped corners.
Set WdShape = WdInlineShape.ConvertToShape
WdShape.PictureFormat.ColorType = msoPictureAutomatic
'Snip the corners
WdShape.AutoShapeType = msoShapeSnip2DiagRectangle
WdShape.Fill.Solid
With WdShape.Line
.Weight = 7
.Style = msoLineSingle
.ForeColor.RGB = 16777215
End With
With WdShape.Shadow
.Style = msoShadowStyleOuterShadow
.Blur = 7
.Transparency = 0.55
.Size = 100
End With
With WdShape.ThreeD
.BevelBottomType = msoBevelNone
.BevelBottomDepth = 0
.BevelBottomInset = 0
.BevelTopType = msoBevelCircle
.BevelTopDepth = 1.5
.BevelTopInset = 2
.FieldOfView = 45
.Perspective = msoFalse
.PresetMaterial = msoMaterialWarmMatte
.PresetLighting = msoLightRigTwoPoint
.LightAngle = 120
End With
WdShape.ConvertToInlineShape
End Sub
Public Sub AddRoundedDiagonalCornerWhite()
Dim WdInlineShape As InlineShape
Dim WdShape As Shape
Set WdInlineShape = ActiveDocument.InlineShapes(1)

'Convert to shape. I could be wrong, but this seems to be the only way to get the rounded corners.
Set WdShape = WdInlineShape.ConvertToShape
WdShape.PictureFormat.ColorType = msoPictureAutomatic
'Snip the corners
WdShape.AutoShapeType = msoShapeRound2DiagRectangle
WdShape.Fill.Solid
With WdShape.Line
.Weight = 7
.Style = msoLineSingle
.ForeColor.RGB = 16777215
End With
With WdShape.Shadow
.Style = msoShadowStyleOuterShadow
.Blur = 7
.Transparency = 0.55
.Size = 100
End With
With WdShape.ThreeD
.BevelBottomType = msoBevelNone
.BevelBottomDepth = 0
.BevelBottomInset = 0
.BevelTopType = msoBevelCircle
.BevelTopDepth = 1.5
.BevelTopInset = 2
.FieldOfView = 45
.Perspective = msoFalse
.PresetMaterial = msoMaterialWarmMatte
.PresetLighting = msoLightRigTwoPoint
.LightAngle = 120
End With
WdShape.ConvertToInlineShape
End Sub

[gmaxey]

Ok, back to your original post. I am not sure that the results here "exactly" replicate the preset style, but it appeaars to be very close:

Sub Demo()
Dim iShp As InlineShape
With ActiveDocument
For Each iShp In .InlineShapes
If iShp.Range.Information(wdWithInTable) = True Then
With iShp
.LockAspectRatio = True
.Width = .Range.Cells(1).Column.Width - 50 'You might have to tinker with the width a bit.
End With
AddRoundedDiagonalCornerWhite iShp
End If
Next
End With
End Sub
Public Sub AddRoundedDiagonalCornerWhite(ByRef oILSPassed As InlineShape)
Dim WdShape As Shape
'Convert to shape. I could be wrong, but this seems to be the only way to get the rounded corners.
Set WdShape = oILSPassed.ConvertToShape
WdShape.PictureFormat.ColorType = msoPictureAutomatic
'Rounded the corners
WdShape.AutoShapeType = msoShapeRound2DiagRectangle
'Set other attributes to match preformatted picture.
WdShape.Fill.Solid
With WdShape.Line
.Weight = 7
.Style = msoLineSingle
.ForeColor.RGB = 16777215
End With
With WdShape.Shadow
.Style = msoShadowStyleOuterShadow
.Blur = 7
.Transparency = 0.55
.Size = 100
End With
With WdShape.ThreeD
.BevelBottomType = msoBevelNone
.BevelBottomDepth = 0
.BevelBottomInset = 0
.BevelTopType = msoBevelCircle
.BevelTopDepth = 1.5
.BevelTopInset = 2
.FieldOfView = 45
.Perspective = msoFalse
.PresetMaterial = msoMaterialWarmMatte
.PresetLighting = msoLightRigTwoPoint
.LightAngle = 120
End With
WdShape.ConvertToInlineShape
End Sub

[r_know]

Dear Greg,

You are Fabulous, It worked exact same which I am looking for...

Appreciated your efforts, time and great work to solve this thread.

Thank You Very Much

Regards,

Rahul

[gmaxey]

Rahul,

Actually the format I gave you wasn't as close as it could be. I was focused on the "snipped" edge rather than the rounded edge. So a closer match for the rounded edge is:

Public Sub AddRoundedDiagonalCornerWhite(ByRef oILSPassed As InlineShape)
Dim WdShape As Shape
'Convert to shape. I could be wrong, but this seems to be the only way to get the rounded corners.
Set WdShape = oILSPassed.ConvertToShape
WdShape.PictureFormat.ColorType = msoPictureAutomatic
'Rounded the corners
WdShape.AutoShapeType = msoShapeRound2DiagRectangle
'Set other attributes to match preformatted picture.
With WdShape.Line
.Weight = 7
.Style = msoLineSingle
.ForeColor.RGB = 16777215
End With
With WdShape.Shadow
.Style = msoShadowStyleOuterShadow
.Blur = 20
.Transparency = 0.57
.Size = 100
End With
'Maybe someone knows how to select the image and apply SendKeys or some other method _
to apply a "Flat" cap attibute and a "Mitered" join attribute to the line style.
'WdShape.Select
WdShape.ConvertToInlineShape
End Sub

Note that in the formatting dialog that there are two attributes for the "Line Style"

Cap type and Join Type. When you insert a picture and add a border line the join type defaults to "Round." There doesn't appear to be any access in the object module (at least I couldn't find it) to set this to "Mitered" which is the join type set in the predefined style. Accordingly, you will notice that the square corners of the white border aren't actually squard but rounded slightly.

I suppose that you could also select the picture and using SendKeys or something manipulte the dialog to set this attribute but that is an area that causes me to cuss worse than the sailor I once was, so I avoid it.

Good luck.

[gmaxey]

Rahul,

Here is another method that relies on you manually applying the desired style to the first image. It basically selects and copies the formatting of the first image and then pastes that formatting to all subsequent images.


Sub DemoII()
Dim iShp As InlineShape
Dim i As Long
i = 0
With ActiveDocument
For Each iShp In .InlineShapes

If iShp.Range.Information(wdWithInTable) = True Then
i = i + 1
If i = 1 Then
iShp.Select
Selection.CopyFormat
End If
With iShp
.LockAspectRatio = True
.Width = .Range.Cells(1).PreferredWidth - 50 'You might have to tinker with the width a bit.
End With
If i > 1 Then
iShp.Select
Selection.PasteFormat
End If
End If
Next
End With
End Sub