Picture/Image/Attachment Resizing

[Steven Proud]

In Word I had found some great VBA code to resize BOTH a selected item and all items in a word document.

FOR EXAMPLE IN WORD - TO RESIZE A SELECTED ITEM/PICTURE

Sub ResizePic40Percent()
'
' ResizePic Macro
'
' The macro first asks for a percentage by which you want to scale the selected image,
' offering 75 (75%) as the default. When you specify a percentage, the macro then checks
' to see if the selected graphic is an inline or a floating graphic.
' The reason for doing this is that the object specification is different in each case,
' as well as how the scaling is specified. Inline objects belong to the InlineShapes collection,
' while floating objects are set using the ShapeRange object.
'
Dim PecentSize As Integer
PercentSize = 40
If Selection.InlineShapes.Count > 0 Then
Selection.InlineShapes(1).ScaleHeight = PercentSize
Selection.InlineShapes(1).ScaleWidth = PercentSize
Else
Selection.ShapeRange.ScaleHeight Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
Selection.ShapeRange.ScaleWidth Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
End If
End Sub

FOR EXAMPLE IN WORD - TO RESIZE ALL ITEMS/PICTURES

Sub ResizeAllPictSize40Percent()
' If you want to resize all the graphics in your document by the same percentage,
' then you only need to modify the above macro so that it steps through each of
' the inline graphics and then each of the floating graphics.
Dim PercentSize As Integer
Dim oIshp As InlineShape
Dim oshp As Shape
PercentSize = 40
For Each oIshp In ActiveDocument.InlineShapes
With oIshp
.ScaleHeight = PercentSize
.ScaleWidth = PercentSize
End With
Next oIshp
For Each oshp In ActiveDocument.Shapes
With oshp
.ScaleHeight Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
.ScaleWidth Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
End With
Next oshp
End Sub

THE ABOVE VBA workks great!!!!!

So thought I would adapt this to Outlook since I have to always resize images and other stuff ALL DAY LONG.

The same code from WORD would NOT work in OUTLOOK

I found some other code that works IN OUTLOOK- TO RESIZE ALL ITEMS/PICTURES
It also works great!!!!


Public Sub ResizeAllPictSize40Percent()
' If you want to resize all the graphics in your document by the same percentage,
' then you only need to modify the above macro so that it steps through each of
' the inline graphics and then each of the floating graphics.
Set objDoc = ActiveInspector.WordEditor
Set objWord = objDoc.Application
Dim iShp As Word.InlineShape
Dim iSelection As Word.Selection
Dim PecentSize As Integer
PercentSize = 40

On Error Resume Next
For Each iShp In objDoc.InlineShapes
With iShp
If .ScaleHeight Then
.ScaleHeight = PercentSize
End If
If .ScaleWidth Then
.ScaleWidth = PercentSize
End If
End With
Next iShp
End Sub


MY PROBLEM,

I'm not best at VBA and I NEED to select ONLY one item of many and resize only that item.
I have tried many things without any luck or better understanding.
Help Please

 

[Diane Poremsky]

The problem is with this line:

For Each iShp In objDoc.InlineShapes

Rather than using for each ishp, you need to identify the selected shape and process it. If you know it's always the first shape on the page (or 2nd etc) you can call it by number ishp(1), otherwise you need to get the selected object.

 

[Steven Proud]

The problem is with this line:


Rather than using for each ishp, you need to identify the selected shape and process it. If you know it's always the first shape on the page (or 2nd etc) you can call it by number ishp(1), otherwise you need to get the selected object.

I have tried to find a way to find "the selected object" without luck. for example, I cannot find a ishp(1).selected property for each? This is really my whole question.
Should I have asked this question in the topic of "Ask in Programming and Forums"? Is that what you meant. I am sorry, but my first post ever on any website - I'm a little behind the times at age 46.

 

[Diane Poremsky]

The forum doesn't really matter, although Michael has a better chance of seeing it. (He's the resident programming expert.) I'll move the thread there.

Have you tried using ishp(1) as the selected shape object?

 

[Michael Bauer]

The very first macro should do it. All you usually need to do to make a Word macro running in Outlook (2007 and higher) is to get a reference on the Word.Selection object. Here's a sample, add its lines to the first one before it accesses the Selection object.

 

[Steven Proud]

The very first macro should do it. All you usually need to do to make a Word macro running in Outlook (2007 and higher) is to get a reference on the Word.Selection object. Here's a sample, add its lines to the first one before it accesses the Selection object.

Thank you very much for the information - I finally have this working with the following Code as my working code.

Public Sub ResizePic40Percent()

' ResizePic macro
' The macro first will attempt scale the selected image to the specified percentage,
' the macro then checks to see if the selected graphic is an inline or a floating graphic.
' The reason for doing this is that the object specification is different in each case,
' as well as how the scaling is specified. Inline objects belong to the InlineShapes collection,
' while floating objects are set using the ShapeRange object.

Dim Ins As Outlook.Inspector
Dim Document As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection

Set Ins = Application.ActiveInspector
Set Document = Ins.WordEditor
Set Word = Document.Application
Set Selection = Word.Selection

Dim PecentSize As Integer
PercentSize = 40

On Error Resume Next

If Selection.InlineShapes.Count > 0 Then
Selection.InlineShapes(1).ScaleHeight = PercentSize
Selection.InlineShapes(1).ScaleWidth = PercentSize
Else
Selection.ShapeRange.ScaleHeight Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
Selection.ShapeRange.ScaleWidth Factor:=(PercentSize / 100), _
RelativeToOriginalSize:=msoCTrue
End If

End Sub