Resizing image in Word VB macro

[FrenchCAD]

Hi,

My company recently changed its logo and I now need to change it on hundreds Word documents, in the header.

I wrote a macro to fulfill this task. It works well but just doesnt resize the image. Any help is welcome.

Thanks in advance.

Sub SwapLogo()
'
' SwapLogo Macro
' Macro enregistrée le 24/02/04 par guichard cyril
'
'=============== Activation de l'entête dde document ==========
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

'=============== Dimensionnement des hauteurs de lignes du tableau ==========
Selection.Cells.HeightRule = wdRowHeightAuto
With Selection.Tables(1).Rows
.Alignment = wdAlignRowLeft
.AllowBreakAcrossPages = True
.SetLeftIndent LeftIndent:=CentimetersToPoints(0.13), RulerStyle:= _
wdAdjustNone
End With
Selection.SelectRow
Selection.Cells.SetHeight RowHeight:=15, HeightRule:=wdRowHeightExactly
With Selection.Rows
.Alignment = wdAlignRowLeft
.AllowBreakAcrossPages = True
.SetLeftIndent LeftIndent:=CentimetersToPoints(0.13), RulerStyle:= _
wdAdjustNone
End With
Selection.Move Unit:=wdRow, Count:=1
Selection.SelectRow
Selection.Cells.SetHeight RowHeight:=36, HeightRule:=wdRowHeightExactly
With Selection.Rows
.Alignment = wdAlignRowLeft
.AllowBreakAcrossPages = True
.SetLeftIndent LeftIndent:=CentimetersToPoints(0.13), RulerStyle:= _
wdAdjustNone
End With
Selection.Move Unit:=wdRow, Count:=1
Selection.SelectRow
Selection.Cells.SetHeight RowHeight:=15, HeightRule:=wdRowHeightExactly
With Selection.Rows
.Alignment = wdAlignRowLeft
.AllowBreakAcrossPages = True
.SetLeftIndent LeftIndent:=CentimetersToPoints(0.13), RulerStyle:= _
wdAdjustNone
End With

'=============== On efface l'ancien logo ==========
Selection.Cells(1).Select
Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

'=============== Fusion des cellules ==========
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Cells.Merge

'=============== Insertion nouveau logo ==========
Selection.InlineShapes.AddPicture FileName:="D:\logos\logo_black.jpg", _
LinkToFile:=False, SaveWithDocument:=True

'=============== Redimensionnement de la colonne =========
Selection.SelectColumn
With Selection.Cells
.SetWidth ColumnWidth:=80, RulerStyle:=wdAdjustFirstColumn
.VerticalAlignment = wdAlignVerticalCenter
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'=============== Redimensionnement du logo =========
Selection.ShapeRange.Select
With Selection.ShapeRange
.ScaleHeight 300, msoFalse, msoScaleFromTopLeft
.ScaleWidth 300, msoFalse, msoScaleFromTopLeft
End With

'=============== Retour au corps de document ==========
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

The returned error says the object doesnt exist in the library.

Cyril Guichard
Mechanical Engineer

 

[joerd]

It looks like you take the ShapeRange twice (so you are basically looking at: Selection.ShapeRange.ShapeRange.ScaleHeight)
Delete the line Selection.ShapeRange.Select, and keep the With ... End With part.
Hope this works, since I couldn't test it, of course.
Salut!

Cheers,
Joerd

Please see FAQ731-376 for tips on how to make the best use of Eng-Tips.

 

[FrenchCAD]

nope it doesnt work either, already tried this one.

Wish their was a Selection.SelectShape available, as there is a Selection.SelectColumn. It would make things alot more easier...

Cyril Guichard
Mechanical Engineer

 

[joerd]

Selection.ShapeRange gives you all the shapes in the selection, but you can pick, for example, the first one by Selection.ShapeRange(1) which is equal to using Selection.ShapeRange.Item(1). This should give you a handle on only the first shape.
Can you step through the code and see how the selection changes as you select the table/column/shapes?

Cheers,
Joerd

Please see FAQ731-376 for tips on how to make the best use of Eng-Tips.

 

[FrenchCAD]

well, from the error returned, it looks like my image isn't created, but it is. When I try to call it as item, Word says there is no item found in the column. Weird stuff.

Cyril Guichard
Mechanical Engineer