ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,832
- Office Version
- 2007
- Platform
- Windows
Hi,
I am using the Macro code shown below.
Currently when i press the button a box pops up & i then need to browse to where the picture is.
I would like to be able to press the button where this time when the box pops up just take me to the folder.
The path for the folder is called C:\Users\Ian\Desktop
Also lets say there is a photo already in cell B9 but i want to change it, i have noticed that if i select this picture and run through the insert process it then puts the new inserted picture in the next cell as opposed the the selected B9 cell.
Is it possible that when i try to insert a picture show a Msgbox YES NO asking if i wish to replace it,YES to overwrite & No to exit code etc.
I am using the Macro code shown below.
Currently when i press the button a box pops up & i then need to browse to where the picture is.
I would like to be able to press the button where this time when the box pops up just take me to the folder.
The path for the folder is called C:\Users\Ian\Desktop
Also lets say there is a photo already in cell B9 but i want to change it, i have noticed that if i select this picture and run through the insert process it then puts the new inserted picture in the next cell as opposed the the selected B9 cell.
Is it possible that when i try to insert a picture show a Msgbox YES NO asking if i wish to replace it,YES to overwrite & No to exit code etc.
Code:
Sub CompressPicture()Dim fName As String
Dim pic As Picture
Dim r As Range
fName = Application.GetOpenFilename( _
FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
Title:="Please select an image...")
If fName = "False" Then Exit Sub
Set r = ActiveCell
Set pic = Worksheets("LP ME").Pictures.Insert(fName)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Left = r.Left
.Top = r.Top
.Width = r.Width
.Height = r.Height
.Select
End With
If TypeName(Selection) = "Picture" Then
Application.SendKeys "%a~"
Application.CommandBars.ExecuteMso "PicturesCompress"
End If
End Sub