Macro for Picture size and crop, layout and position in table.

[rv.aleixo.alves]

Hello, everyone!

I'm trying to make a macro to format pictures automatically after I insert them in a table in a word document.
I want to resize the pictures to 60% (Height and Width) and crop the margins (0.6 centimetres from top, left and right and 0.4 from bottom). Then I want the picture, to be inside the table, to have a text wrapping = Top andbottom, send to backwards, and then I want to change its layout to: horizontal alignment center relative to column; vertical absolute position, 0 cm to paragraph.
What I've accomplished so far (reading this group) was this macro code:

Sub FDiagCoord()
On Error GoTo ErrorHandler
Dim oILS As InlineShape
Set oILS = Selection.InlineShapes(1)
With oILS
.PictureFormat.CropLeft = CentimetersToPoints(0.6)
.PictureFormat.CropTop = CentimetersToPoints(0.6)
.PictureFormat.CropRight = CentimetersToPoints(0.6)
.PictureFormat.CropBottom = CentimetersToPoints(0.4)
End With
With oILS
.LockAspectRatio = True
.ScaleHeight = 60
End With
Set oShp = Selection.InlineShapes(1).ConvertToShape
oShp.WrapFormat.Type = wdWrapTopBottom
oShp.ZOrderCmd = msoSendBackward
oShp.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
oShp.wdRelativeHorizontalPositionColumn = wdCenter
Exit Sub
ErrorHandler:
MsgBox "No picture selected."
End Sub


It doesn't work completely, something is missing... And I'm stuck for quieta while now...
Can somebody help me?
Thank you very much,
Ricardo

 

[Stefan Blom]

There isn't much traffic in this newsgroup anymore, so you should post in a
programming forum at MSDN. For example, try the Word for Developers forum at
http://social.msdn.microsoft.com/Forums/en-US/worddev/threads (if you haven't
already).

--
Stefan Blom
Microsoft Word MVP




(e-mail address removed) wrote in message

Hello, everyone!

I'm trying to make a macro to format pictures automatically after I insert them
in a table in a word document.
I want to resize the pictures to 60% (Height and Width) and crop the margins
(0.6 centimetres from top, left and right and 0.4 from bottom). Then I want the
picture, to be inside the table, to have a text wrapping = Top and bottom, send
to backwards, and then I want to change its layout to: horizontal alignment
center relative to column; vertical absolute position, 0 cm to paragraph.
What I've accomplished so far (reading this group) was this macro code:

Sub FDiagCoord()
On Error GoTo ErrorHandler
Dim oILS As InlineShape
Set oILS = Selection.InlineShapes(1)
With oILS
.PictureFormat.CropLeft = CentimetersToPoints(0.6)
.PictureFormat.CropTop = CentimetersToPoints(0.6)
.PictureFormat.CropRight = CentimetersToPoints(0.6)
.PictureFormat.CropBottom = CentimetersToPoints(0.4)
End With
With oILS
.LockAspectRatio = True
.ScaleHeight = 60
End With
Set oShp = Selection.InlineShapes(1).ConvertToShape
oShp.WrapFormat.Type = wdWrapTopBottom
oShp.ZOrderCmd = msoSendBackward
oShp.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
oShp.wdRelativeHorizontalPositionColumn = wdCenter
Exit Sub
ErrorHandler:
MsgBox "No picture selected."
End Sub


It doesn't work completely, something is missing... And I'm stuck for quiet a
while now...
Can somebody help me?
Thank you very much,
Ricardo

 

[rv.aleixo.alves]

Thank you, Stefan, I'll do that.

 

[rv.aleixo.alves]

Well, to post my question there I need to have a hotmail account, which I don't have and don't want to have. So, I improve a little bit my code but I still can't put the macro centering my shape in horizontal position and align 0 centimeters to paragraph. Can somebody help me here, please?
Here is my code:
Sub FDiagCoord()
'
' Formatar os diagramas que têm coordenadas.
'
On Error GoTo ErrorHandler
Dim oILS As InlineShape
Set oILS = Selection.InlineShapes(1)
With oILS
.PictureFormat.CropLeft = CentimetersToPoints(0.6)
.PictureFormat.CropTop = CentimetersToPoints(0.6)
.PictureFormat.CropRight = CentimetersToPoints(0.6)
.PictureFormat.CropBottom = CentimetersToPoints(0.4)
End With
With oILS
.LockAspectRatio = True
.ScaleHeight = 60
End With
Set oShp = Selection.InlineShapes(1).ConvertToShape
oShp.WrapFormat.Type = wdWrapTopBottom
oShp.ZOrder msoSendToBack
With oShp
.Center
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.CentimetersToPoints (0)
.RelativeHorizontalPosition = wdRelativeVerticalPositionParagraph
End With
Exit Sub
ErrorHandler:
MsgBox "Nenhum diagrama selecionado."
End Sub

Thank you for you patience,
Ricardo

 

[Stefan Blom]

Well, to post my question there I need to have a hotmail account, which I

don't have and don't want to have.

Strictly speaking, what you need is a Live ID login. You can use any e-mail
address as the basis for the Live ID.

 

[john.b.roberts]

Well, to post my question there I need to have a hotmail account, which Idon't have and don't want to have. So, I improve a little bit my code but I still can't put the macro centering my shape in horizontal position and align 0 centimeters to paragraph. Can somebody help me here, please?

Here is my code:

Sub FDiagCoord()

'

' Formatar os diagramas que têm coordenadas.

'

On Error GoTo ErrorHandler

Dim oILS As InlineShape

Set oILS = Selection.InlineShapes(1)

With oILS

.PictureFormat.CropLeft = CentimetersToPoints(0.6)

.PictureFormat.CropTop = CentimetersToPoints(0.6)

.PictureFormat.CropRight = CentimetersToPoints(0.6)

.PictureFormat.CropBottom = CentimetersToPoints(0.4)

End With

With oILS

.LockAspectRatio = True

.ScaleHeight = 60

End With

Set oShp = Selection.InlineShapes(1).ConvertToShape

oShp.WrapFormat.Type = wdWrapTopBottom

oShp.ZOrder msoSendToBack

With oShp

.Center

.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn

.CentimetersToPoints (0)

.RelativeHorizontalPosition = wdRelativeVerticalPositionParagraph

End With

Exit Sub

ErrorHandler:

MsgBox "Nenhum diagrama selecionado."

End Sub



Thank you for you patience,

Ricardo

After many hours of struggling to achieve something similar (paste a graphic from the clipboard into a table cell, in a document section that is formatted with two columns... Set the graphic a bit below the paragraph the insertion point was in when the macro started, and center it in the column (now, on reflection, I'm not sure if the "center" action relates to the table column, or the section/page column, but the result looks as desired so...) Here is my code... (note error handling omitted - and I've added comments and made a few small changes in this post, so use at your own risk!)

Sub AddPicture()
'
Dim rng As Word.Range
Dim Ishp As InlineShape
Dim shp As Shape
Dim rngPar As Word.Range
Dim rngParEnd As Word.Range
Dim sglTop As Single
 
'remember the current selection point
Set rng = Selection.Range

'set two objects to the current paragraph
Set rngPar = Selection.Range.Paragraphs(1).Range
Set rngParEnd = Selection.Range.Paragraphs(1).Range

'My insertion point is always at the end of the cell - exclude the end of cell marker from each ranges
rngPar.MoveEnd wdCharacter, -1
rngParEnd.MoveEnd wdCharacter, -1

'Set the "end" marker to the last character in the paragraph 
rngParEnd.Collapse wdCollapseEnd
rngParEnd.MoveStart wdCharacter, -1

'Work out how far apart (vertically) the first and last characters in the paragraph are, and add 20 points (for padding - a bit of white space looks good)
sglTop = rngParEnd.Information(wdVerticalPositionRelativeToPage) - rngPar.Information(wdVerticalPositionRelativeToPage) + 20
 
'Paste the shape (already manually placed in the clipboard) at the insertion point
rng.Paste
'set an inline shape object reference
Set Ishp = rng.InlineShapes(1)
'convert to a shape object and set a reference
Set shp = Ishp.ConvertToShape

With shp
.LayoutInCell = True

'These two work together, as I understand it
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = sglPreviousTop

'These two also work together, as I understand it
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeCenter

'Set the word-wrap (that's half the reason for converting from inLineShape to (plain) Shape - so it can have wrapping

.WrapFormat.AllowOverlap = False
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.DistanceBottom = CentimetersToPoints(0.2)
.WrapFormat.DistanceTop = CentimetersToPoints(0.2)

'Put a border around it
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
 
'Re-Instate previous selection
rng.Select
End Sub

 

[john.b.roberts]

Strictly speaking, what you need is a Live ID login. You can use any e-mail

address as the basis for the Live ID.



--

Stefan Blom

Microsoft Word MVP

After many hours of struggling to achieve something similar (paste a graphic from the clipboard into a table cell, in a document section that is formatted with two columns... Set the graphic a bit below the paragraph the insertion point was in when the macro started, and center it in the column (now, on reflection, I'm not sure if the "center" action relates to the table column, or the section/page column, but the result looks as desired so...) Here is my code... (note error handling omitted - and I've added comments and made a few small changes in this post, so use at your own risk!)

Sub AddPicture()
'
Dim rng As Word.Range
Dim Ishp As InlineShape
Dim shp As Shape
Dim rngPar As Word.Range
Dim rngParEnd As Word.Range
Dim sglTop As Single
 
'remember the current selection point
Set rng = Selection.Range

'set two objects to the current paragraph
Set rngPar = Selection.Range.Paragraphs(1).Range
Set rngParEnd = Selection.Range.Paragraphs(1).Range

'My insertion point is always at the end of the cell - exclude the end of cell marker from each of the ranges
rngPar.MoveEnd wdCharacter, -1
rngParEnd.MoveEnd wdCharacter, -1

'Set the "end" range object to the last character in the paragraph
rngParEnd.Collapse wdCollapseEnd
rngParEnd.MoveStart wdCharacter, -1

'Work out how far apart (vertically) the first and last characters in the paragraph are, and add 20 points (for padding - a bit of white space looks good)
sglTop = rngParEnd.Information(wdVerticalPositionRelativeToPage) - rngPar.Information(wdVerticalPositionRelativeToPage) + 20
 
'Paste the shape (already manually placed in the clipboard) at the insertion point
rng.Paste
'set an inline shape object reference
Set Ishp = rng.InlineShapes(1)
'convert to a shape object and set a reference
Set shp = Ishp.ConvertToShape

With shp
.LayoutInCell = True

'These two work together, as I understand it
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = sglTop

'These two also work together, as I understand it
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeCenter

'Set the word-wrap (that's half the reason for converting from inLineShape to (plain) Shape - so it can have wrapping

.WrapFormat.AllowOverlap = False
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.DistanceBottom = CentimetersToPoints(0.2)
.WrapFormat.DistanceTop = CentimetersToPoints(0.2)

'Put a border around it
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
 
'Re-Instate previous selection
rng.Select
End Sub

 

[rv.aleixo.alves]

Thank you! It seems to be working fine now!
Here is the final code:

Sub FDiagCoord()
'
' Formatar os diagramas que têm coordenadas.
'
On Error GoTo ErrorHandler
Dim oILS As InlineShape
Set oILS = Selection.InlineShapes(1)
With oILS
.PictureFormat.CropLeft = CentimetersToPoints(0.6)
.PictureFormat.CropTop = CentimetersToPoints(0.6)
.PictureFormat.CropRight = CentimetersToPoints(0.6)
.PictureFormat.CropBottom = CentimetersToPoints(0.4)
.LockAspectRatio = True
.ScaleHeight = 60
End With
Set oShp = Selection.InlineShapes(1).ConvertToShape
oShp.WrapFormat.Type = wdWrapTopBottom
oShp.ZOrder msoSendToBack
With oShp
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = sglTop
End With
Exit Sub
ErrorHandler:
End Sub

Strictly speaking, what you need is a Live ID login. You can use any e-mail

address as the basis for the Live ID.



--

Stefan Blom

Microsoft Word MVP

After many hours of struggling to achieve something similar (paste a graphic from the clipboard into a table cell, in a document section that is formatted with two columns... Set the graphic a bit below the paragraph the insertion point was in when the macro started, and center it in the column (now, on reflection, I'm not sure if the "center" action relates to the table column, or the section/page column, but the result looks as desired so...) Here is my code... (note error handling omitted - and I've added comments and made a few small changes in this post, so use at your own risk!)

Sub AddPicture()

'

Dim rng As Word.Range

Dim Ishp As InlineShape

Dim shp As Shape

Dim rngPar As Word.Range

Dim rngParEnd As Word.Range

Dim sglTop As Single



'remember the current selection point

Set rng = Selection.Range



'set two objects to the current paragraph

Set rngPar = Selection.Range.Paragraphs(1).Range

Set rngParEnd = Selection.Range.Paragraphs(1).Range



'My insertion point is always at the end of the cell - exclude the end ofcell marker from each of the ranges

rngPar.MoveEnd wdCharacter, -1

rngParEnd.MoveEnd wdCharacter, -1



'Set the "end" range object to the last character in the paragraph

rngParEnd.Collapse wdCollapseEnd

rngParEnd.MoveStart wdCharacter, -1



'Work out how far apart (vertically) the first and last characters in theparagraph are, and add 20 points (for padding - a bit of white space looksgood)

sglTop = rngParEnd.Information(wdVerticalPositionRelativeToPage) - rngPar.Information(wdVerticalPositionRelativeToPage) + 20



'Paste the shape (already manually placed in the clipboard) at the insertion point

rng.Paste

'set an inline shape object reference

Set Ishp = rng.InlineShapes(1)

'convert to a shape object and set a reference

Set shp = Ishp.ConvertToShape



With shp

.LayoutInCell = True



'These two work together, as I understand it

.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph

.Top = sglTop



'These two also work together, as I understand it

.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn

.Left = wdShapeCenter



'Set the word-wrap (that's half the reason for converting from inLineShape to (plain) Shape - so it can have wrapping



.WrapFormat.AllowOverlap = False

.WrapFormat.Type = wdWrapTopBottom

.WrapFormat.DistanceBottom = CentimetersToPoints(0.2)

.WrapFormat.DistanceTop = CentimetersToPoints(0.2)



'Put a border around it

.Line.Weight = 0.75

.Line.DashStyle = msoLineSolid

.Line.Style = msoLineSingle

.Line.Transparency = 0#

.Line.Visible = msoTrue

.Line.ForeColor.RGB = RGB(0, 0, 0)

.Line.BackColor.RGB = RGB(255, 255, 255)

End With



'Re-Instate previous selection

rng.Select

End Sub

 

[john.b.roberts]

Awsome - pleased to have helped.

in your case the variable sglTop appears un-declared and un-initialised so two suggestions:

1) use Option Explicit in your modules to force variable declaration (this can save much debugging time - trust me). (you would then accordingly need to declare your oShp variable too i.e. - Dim oShp as Shape)

2) change the following line in your code
.Top = sglTop
to
.Top = 0
(which is what is effectively happening as your code stands, but may be confusing to someone else trying to read through it, if they didn't know the history of the code's development).

HTH

Regards

John.