Format all pictures
 

Please can someone tell me if it is possible to reference all pictures on a
worksheet from a macro, without having to manualy select each one
individualy beforehand, so that I can simply change the size of them all.
For instance can they ocupy a range?
Thanks in advance
David

Format all pictures
 

Sub testme01()

Dim myPictureName As Variant
Dim myPict As Picture
Dim myRng As Range
Dim myCurFolder As String
Dim myNewFolder As String

myCurFolder = CurDir
myNewFolder = "yourfoldernamehere"

On Error Resume Next
ChDirNet myNewFolder
If Err.Number < 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0

myPictureName = Application.GetOpenFilename _
(filefilter:="Picture
Files,*.jpg;*.bmp;*.tif;*.gif")

ChDirNet myCurFolder

If myPictureName = False Then
Exit Sub 'user hit cancel
End If

Set myRng = Selection.Areas(1)
Set myPict = myRng.Parent.Pictures.Insert(myPictureName)
myPict.Top = myRng.Top
myPict.Width = myRng.Width
myPict.Height = myRng.Height
myPict.Left = myRng.Left
myPict.Placement = xlMoveAndSize

End Sub

Make a button for the Macro
when you click on the button you will be asked to choose the directory
and file you want to insert
whatever you insert will be inserted into what ever range you have
activated


--
davesexcel
------------------------------------------------------------------------
davesexcel's Profile: http://www.excelforum.com/member.php...o&userid=31708
View this thread: http://www.excelforum.com/showthread...hreadid=516640

Format all pictures
 

This routine needs this, too:

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub



davesexcel wrote:

Sub testme01()

Dim myPictureName As Variant
Dim myPict As Picture
Dim myRng As Range
Dim myCurFolder As String
Dim myNewFolder As String

myCurFolder = CurDir
myNewFolder = "yourfoldernamehere"

On Error Resume Next
ChDirNet myNewFolder
If Err.Number < 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0

myPictureName = Application.GetOpenFilename _
(filefilter:="Picture
Files,*.jpg;*.bmp;*.tif;*.gif")

ChDirNet myCurFolder

If myPictureName = False Then
Exit Sub 'user hit cancel
End If

Set myRng = Selection.Areas(1)
Set myPict = myRng.Parent.Pictures.Insert(myPictureName)
myPict.Top = myRng.Top
myPict.Width = myRng.Width
myPict.Height = myRng.Height
myPict.Left = myRng.Left
myPict.Placement = xlMoveAndSize

End Sub

Make a button for the Macro
when you click on the button you will be asked to choose the directory
and file you want to insert
whatever you insert will be inserted into what ever range you have
activated

--
davesexcel
------------------------------------------------------------------------
davesexcel's Profile: http://www.excelforum.com/member.php...o&userid=31708
View this thread: http://www.excelforum.com/showthread...hreadid=516640

--

Dave Peterson

Format all pictures
 

Oh ya,
I forgot about that part! Thanks

Format all pictures
 

Assuming there are no other objects on the worksheet that would be
considered pictures, you can do

Sub ABC()
With ActiveSheet
.Pictures.Width = 30
.Pictures.Height = 45
End With
End Sub


You will have to consider whether the aspect ratio is locked and so forth.

To test what is in the pictures collect

Sub EFG()
activesheet.pictures.select
End Sub

--
Regards,
Tom Ogilvy




"David Henderson" wrote in message
...
Please can someone tell me if it is possible to reference all pictures on
a
worksheet from a macro, without having to manualy select each one
individualy beforehand, so that I can simply change the size of them all.
For instance can they ocupy a range?
Thanks in advance
David