ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Code to work with ONLY active Sheet not all ? (https://www.excelbanter.com/excel-programming/374619-code-work-only-active-sheet-not-all.html)

Corey

Code to work with ONLY active Sheet not all ?
 
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

Code to work with ONLY active Sheet not all ?
 
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" wrote in message
...
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




Corey

Code to work with ONLY active Sheet not all ?
 

Thanks Tom.


:-)




Regards

Corey




All times are GMT +1. The time now is 05:11 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com