Consulting

Results 1 to 4 of 4

Thread: Solved: Naming inserted pictures

  1. #1
    VBAX Regular
    Joined
    Apr 2008
    Posts
    97
    Location

    Question Solved: Naming inserted pictures

    This should be a simple one but just cant get the right reference to a picture inserted into a sheet. I insert pictures into a sheet based on a retailer number and jpgs with a specific file naming convention.
    The issue is that I cant seem to reference that shape to name it?
    Probably a simple one...
    AAARRRGGG

    [VBA]Sub test()
    Dim retailer As String 'retailer number picture to display
    Dim picture As String
    Dim x As Integer
    retailer = Range("retailer") 'retailer number from cell in sheet
    On Error Resume Next 'kills errors if files not there
    x = 0
    For x = 1 To 6
    picture = "c:\All Retailers\" & retailer & "-" & x & ".jpg"
    Select Case x
    Case 1
    Range("b7").Select 'positions them correctly
    Case 2
    Range("l7").Select
    Case 3
    Range("b30").Select
    Case 4
    Range("l30").Select
    Case 5
    Range("b60").Select
    Case 6
    Range("l60").Select
    End Select
    ActiveSheet.Pictures.Insert(picture).Select 'inserts correct picture
    Selection.Name = "picture" & x 'This will name the picture if the file is there but if not it names the selected cell as AddIn range.
    Selection.ShapeRange.Height = 213#
    Selection.ShapeRange.Width = 325#
    Selection.ShapeRange.IncrementLeft 277
    Selection.ShapeRange.IncrementTop 80
    Next x
    Range("a1").Select
    On Error GoTo 0
    End Sub[/VBA]

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Worked fine for me, although it did bring the same picture in 6 times, and it did put them all on top of each other.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Apr 2008
    Posts
    97
    Location
    The code is used in excel 2003 so if 2007 on it will not relocate them properly.
    The for next loop should have looked for pictures from -1 to -6.

    The problem I have is when one or more of the files do not exist and the emty seleced cell is then named "picturex"

    If i could reference the picture object and name it like activesheet.shape(selectedshape).name = picturex that would work for me.

  4. #4
    VBAX Regular
    Joined
    Apr 2008
    Posts
    97
    Location

    Smile Different approach

    Rusty in coding again

    I just should have used an if statement to quailify if the picture was sucsessfully insterted and then name the selection. Wrong approach but I still would like to know how to determine if the selected object is a picture or a cell?
    I used the code below and I am good to go.
    Thanks all for the patence.
    [vba]Sub test()
    Application.ScreenUpdating = False
    Dim retailer As String
    Dim picture As String
    Dim x As Integer
    retailer = Range("retailer")
    For x = 1 To 6
    picture = "c:\All Retailers\" & retailer & "-" & x & ".jpg" 'sets correct file name
    Select Case x
    Case 1
    Range("b7").Select ' positions picture correctly on screen
    Case 2
    Range("l7").Select
    Case 3
    Range("b30").Select
    Case 4
    Range("l30").Select
    Case 5
    Range("b60").Select
    Case 6
    Range("l60").Select
    End Select
    On Error Resume Next
    ActiveSheet.Pictures.Insert(picture).Select
    If Err = 1004 Then 'if picture does not exist then skip
    Err = 0
    Else
    Selection.Name = "picture" & x 'names to shapeobject to it can be referenced later
    If Application.Version = "12.0" Then
    With Selection.ShapeRange
    .Height = 213# 'sizes the picture to a consistent size and location regardless of file size
    .Width = 325#
    .IncrementLeft 277
    .IncrementTop 80
    End With
    Else
    Selection.ShapeRange.Height = 213#
    Selection.ShapeRange.Width = 288#
    End If
    End If
    Next x
    On Error GoTo 0
    End Sub[/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •