The below code inserts a Photo into the selected cell and sizes it to suit
my needs,
But i need this code to ONLY place a photo into the active sheet instead of
ALL sheets in the workbook.
How can i modify the below to do this??


#######################################################################
Sub Picture_Adder()
Application.ScreenUpdating = False
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim myPic As Picture
Dim res As Variant
'Const sAddress As String = ActiveCell
Set WB = ActiveWorkbook
res = Application.GetOpenFilename _
("Image Files (*.jpg), *.jpg")
If res = False Then Exit Sub
For Each SH In WB.Worksheets ' <======================= ONLY ACTIVE
WORK SHEET NOT ALL WORKSHEETS
Set rng = ActiveCell 'SH.Range(sAddress)
Set myPic = SH.Pictures.Insert(res)
With myPic
.Top = rng.Top
.Left = rng.Left
myPic.ShapeRange.LockAspectRatio = msoFalse
myPic.ShapeRange.Height = 177#
myPic.ShapeRange.Width = 235.5
myPic.ShapeRange.Rotation = 0#
End With
Next SH ' <======================================= DELETE THIS
Application.ScreenUpdating = True
End Sub

################################################################################



Regards

Corey

Sub Picture_Adder()
Application.ScreenUpdating = False
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim myPic As Picture
Dim res As Variant
'Const sAddress As String = ActiveCell
Set WB = ActiveWorkbook
res = Application.GetOpenFilename _
("Image Files (*.jpg), *.jpg")
If res = False Then Exit Sub
set SH = Activesheet
Set rng = ActiveCell
Set myPic = SH.Pictures.Insert(res)
With myPic
.Top = rng.Top
.Left = rng.Left
myPic.ShapeRange.LockAspectRatio = msoFalse
myPic.ShapeRange.Height = 177#
myPic.ShapeRange.Width = 235.5
myPic.ShapeRange.Rotation = 0#
End With
End if
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy


"Corey" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> The below code inserts a Photo into the selected cell and sizes it to suit
> my needs,
> But i need this code to ONLY place a photo into the active sheet instead
> of ALL sheets in the workbook.
> How can i modify the below to do this??
>
>
> #######################################################################
> Sub Picture_Adder()
> Application.ScreenUpdating = False
> Dim WB As Workbook
> Dim SH As Worksheet
> Dim rng As Range
> Dim myPic As Picture
> Dim res As Variant
> 'Const sAddress As String = ActiveCell
> Set WB = ActiveWorkbook
> res = Application.GetOpenFilename _
> ("Image Files (*.jpg), *.jpg")
> If res = False Then Exit Sub
> For Each SH In WB.Worksheets ' <======================= ONLY ACTIVE
> WORK SHEET NOT ALL WORKSHEETS
> Set rng = ActiveCell 'SH.Range(sAddress)
> Set myPic = SH.Pictures.Insert(res)
> With myPic
> .Top = rng.Top
> .Left = rng.Left
> myPic.ShapeRange.LockAspectRatio = msoFalse
> myPic.ShapeRange.Height = 177#
> myPic.ShapeRange.Width = 235.5
> myPic.ShapeRange.Rotation = 0#
> End With
> Next SH ' <======================================= DELETE THIS
> Application.ScreenUpdating = True
> End Sub
>
> ################################################################################
>
>
>
> Regards
>
> Corey
>

Thanks Tom.


:-)




Regards

Corey