Format all pictures

[David Henderson]

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

[davesexcel]

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

[Dave Peterson]

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

[dmexcel]

Oh ya,
I forgot about that part! Thanks

[Tom Ogilvy]

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" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>