Consulting

Results 1 to 6 of 6

Thread: Insert Picture With Cell Reference In Excel VBA Dont Show In Other Computers (Help)

  1. #1

    Insert Picture With Cell Reference In Excel VBA Dont Show In Other Computers (Help)

    Hi,

    To create my organization chart I needed to insert pictures to BT2:BV2 cell using ID number as reference in cell D2 from a folder on which employee photos saved as IDnumber.jpg.
    I know almost nothing about macros but I could figure out to find below code and create my organization chart
    The problem is when I send the chart to other people, the photos disappear since it is not embedded but linked.
    Can anyone Kindly help me to correct my code?


    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
    Dim myPict As Picture

    With Range("bt2:bv2")
    Set myPict = Range("bt2:bv2").Parent.Pictures.Insert("N:\Organization Chart\Pictures" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
    End With

    End Sub

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Welcome to the forum!

    Please paste code between code tags. Click the # icon on the reply toolbar to insert those tags.

    The file name is Pictures plus some IDnumber.jpg? Maybe Pictures is a subfolder?

    I would suggest adding code to Name the picture object so that you can delete it before insert/add.

    Use the sheet's Shape object and AddPicture method. It allows links or embedded shape objects.

    Not fully fleshed out but this should give you an idea.
    Sub Main()  
      Dim s As Shape, r As Range, pic As String
      pic = "c:\temp\Ken.jpg"
      Set r = Sheet1.Range("BT2:BV2")
      Set s = Sheet1.Shapes.AddPicture(pic, _
          msoFalse, msoCTrue, r.Left, r.Top, r.Width, r.RowHeight)
      s.Name = "Ken"
    End Sub

  3. #3
    Thank you Mr Hobs,

    "N:\Organization Chart\Pictures" is the folder where I keep pictures.
    For example if employee ID is 14048,I keep it as "N:\Organization Chart\Pictures\14048.jpg"
    And I want to insert employee's photo to "BT2:BV2" when I type ID number in "D2"
    So when I type "14048" in "D2" cell,I want "14048.jpg" to be inserted.When I type "7698",I want "7698.jpg" to be inserted.

    I couldn't understand how can I use D2 cell connection with your code.
    Or is there any possibility that I can add embed action to my code?

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I have not tested it but it should go something like:
    Private Sub Worksheet_Change(ByVal Target As Range)  
      If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
      
      Dim s As Shape, p As String
      With Range("BT2:BV2")
        On Error Resume Next
        ActiveSheet.Shapes("ID").Delete
        On Error GoTo 0
        p = "N:\Organization Chart\Pictures\" & Target.Value & ".jpg"
        Set s = ActiveSheet.Shapes.AddPicture(p, msoFalse, msoCTrue, .Left, .Top, .Width, .RowHeight)
        s.Name = "ID"
      End With
    End Sub

  5. #5
    Great !Thank you very much.

    This solved the issue well.I tested it and now we can see the photos in other computers also.

    For a second step improvement,I wonder if there is any possibility to extend this code for row 2 completely.
    Example : Type ID in "E2" and get picture in "E2",type ID in "F2" and get picture in "F2" ........... type ID in "Z2" and get picture in "Z2"

  6. #6
    Hi

    I could write the code with trial-error method.Sharing for people who may need
    Thanks for your supports

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("9:9")) Is Nothing Then Exit Sub

    Dim s As Shape, p As String
    With Target.Offset(1, 0)
    t = .Top
    l = .Left
    w = .Offset(0, .Columns.Count).Left - .Left
    h = .Offset(.Rows.Count, 0).Top - .Top
    On Error Resume Next
    On Error GoTo 0
    p = "N:\Org Dev Pln Dpt\OPR R_OD\OPR R_OD_OD\Leader Studies\gl posts study\TMMT" & Target.Value & ".jpg"
    Set s = ActiveSheet.Shapes.AddPicture(p, msoFalse, msoCTrue, .Left, .Top, .Width, .RowHeight)
    s.Name = "ID"
    End With
    End Sub

Posting Permissions

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