Code to work with ONLY active Sheet not all ?

[Corey]

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

 

[Tom Ogilvy]

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

 

[Corey]

Thanks Tom.







Regards

Corey