Excel VBA Picture insert but can't be shared with another computer

[Logihk]

Hi experts!

I have an Excel VBA that will look up a cell value and insert the picture in a designated cell in return. I have already included the LinkToFile:=msoFalse and SaveWithDocument:=msoTrue. However, I still can't see the photos when I open the file in another computer.

Can you all help me take a look at my VBA codes and see where did I do wrong? Does it also matter which Excel format I save the file in?

Thanks a lot in advance!!!!

Below is the VBA Code:



Private Sub Worksheet_change()

Dim myPict As Picture
Dim PictureLoc As String

If Target.Address = Range("B2").Address Then

PictureLoc = "C:\Users\Paul.Man\Pictures\Product pics\" & Range("B2").Value & ".png"

With Range("A2")
Set myPict = ActiveSheet.Shapes.AddPicture( _
PictureLoc, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Top:=imgTop, _
Left:=imgLeft)
End With

End If

End Sub

 

[Domenic]

The reason why you're getting that error is that the variable Target has not been defined.

I'm a little bit confused, though. Your original code was an event handler, whereas your latest code is a regular procedure. Also, your original code would get triggered only when the value in cell B2 changed. However, your posted image suggests that you want the event handler triggered whenever there's a change in value in any cell in Column B, except B1 and B2.

Can you please clarify your intent?

 

[Logihk]

The reason why you're getting that error is that the variable Target has not been defined.

I'm a little bit confused, though. Your original code was an event handler, whereas your latest code is a regular procedure. Also, your original code would get triggered only when the value in cell B2 changed. However, your posted image suggests that you want the event handler triggered whenever there's a change in value in any cell in Column B, except B1 and B2.

Can you please clarify your intent?

Good day Domenic, sorry about the confusion as this is my first time trying to create a macro with VBA code. I just copied someone else code and try to modify it. That may be why the code doesn't make logical sense.

Basically my intention is to run a macro to look up SKU value that will be in any cell of column B but the value will only start from B2 (since B1 maybe a heading), and it will find the pictures from a local folder while inserting the related pictures into cells of column A just beside each of the SKU value.

At first, I tried to use someone else code and it seems to be working until I found that the other computer can't see the picture after sharing. Then I tried to modified again and totally got confused with all the code.

Thanks!

 

[Micron]

Trouble shooting 101: step through your code and check your variables and references (please don't ask me how, rather, Google it). Here's one of 1.5 million hits:

https://www.myonlinetraininghub.com/debugging-vba-code

That would tell you what's wrong with your expectation of Target.Address - and maybe other issues if there are any.
Looks like you're back to posting code outside of tags

 

[Domenic]

Try the following code, which needs to be place in the code module for your worksheet (right-click the sheet tab, select View Code, and place the code in the code module)...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub 'if more than one cell is updated at once, exit the sub
    
    If Target.Row > 1 Then 'make sure updated cell is not located in the first row
    
        If Not Intersect(Target, Range("B:B")) Is Nothing Then 'make sure the updated cell is located in Column B
        
            DeleteImage Range("A" & Target.Row) 'delete existing image from corresponding cell in Column A, if one exists
        
            If Len(Target) > 0 Then 'make sure updated cell is not blank
        
                Dim PictureLoc As String
                PictureLoc = "C:\Users\Paul.Man\Pictures\Product pics\" & Target.Value & ".png"
                
                If Len(Dir(PictureLoc, vbNormal)) > 0 Then 'make sure file exists
                    With Range("A" & Target.Row)
                        Dim myPict As Shape
                        Set myPict = ActiveSheet.Shapes.AddPicture( _
                            Filename:=PictureLoc, _
                            LinkToFile:=msoFalse, _
                            SaveWithDocument:=msoTrue, _
                            Left:=.Left, _
                            Top:=.Top, _
                            Width:=40, _
                            Height:=40)
                    End With
                End If
                
            End If
                        
        End If
        
    End If
    
End Sub

Private Sub DeleteImage(ByVal Target As Range)

    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(Target, shp.TopLeftCell) Is Nothing Then
                shp.Delete
                Exit For
            End If
        End If
    Next shp
    
End Sub

Hope this helps!

 

[Domenic]

As per your request, I have converted the event handler into a regular procedure/macro. Change the name of the worksheet where specified as desired.

Public Sub GetPictures()

    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1") 'change the sheet name accordingly

    Dim lastRow As Long
    With sourceWorksheet
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
   
    Dim i As Long
    For i = 2 To lastRow 'start from the second row
   
        With sourceWorksheet

            DeleteImage .Cells(i, "A") 'delete existing image from corresponding cell in Column A, if one exists
       
            If Len(.Cells(i, "B")) > 0 Then 'make sure updated cell is not blank
       
                Dim PictureLoc As String
                PictureLoc = "C:\Users\Paul.Man\Pictures\Product pics\" & .Cells(i, "B").Value & ".png"
               
                If Len(Dir(PictureLoc, vbNormal)) > 0 Then 'make sure file exists
                    With .Cells(i, "A")
                        Dim myPict As Shape
                        Set myPict = .Parent.Shapes.AddPicture( _
                            Filename:=PictureLoc, _
                            LinkToFile:=msoFalse, _
                            SaveWithDocument:=msoTrue, _
                            Left:=.Left, _
                            Top:=.Top, _
                            Width:=40, _
                            Height:=40)
                    End With
                End If
               
            End If
               
        End With
               
    Next i
   
End Sub

Private Sub DeleteImage(ByVal Target As Range)

    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(Target, shp.TopLeftCell) Is Nothing Then
                shp.Delete
                Exit For
            End If
        End If
    Next shp
   
End Sub

Hope this helps!

 

[Logihk]

Try the following code, which needs to be place in the code module for your worksheet (right-click the sheet tab, select View Code, and place the code in the code module)...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub 'if more than one cell is updated at once, exit the sub
  
    If Target.Row > 1 Then 'make sure updated cell is not located in the first row
  
        If Not Intersect(Target, Range("B:B")) Is Nothing Then 'make sure the updated cell is located in Column B
      
            DeleteImage Range("A" & Target.Row) 'delete existing image from corresponding cell in Column A, if one exists
      
            If Len(Target) > 0 Then 'make sure updated cell is not blank
      
                Dim PictureLoc As String
                PictureLoc = "C:\Users\Paul.Man\Pictures\Product pics\" & Target.Value & ".png"
              
                If Len(Dir(PictureLoc, vbNormal)) > 0 Then 'make sure file exists
                    With Range("A" & Target.Row)
                        Dim myPict As Shape
                        Set myPict = ActiveSheet.Shapes.AddPicture( _
                            Filename:=PictureLoc, _
                            LinkToFile:=msoFalse, _
                            SaveWithDocument:=msoTrue, _
                            Left:=.Left, _
                            Top:=.Top, _
                            Width:=40, _
                            Height:=40)
                    End With
                End If
              
            End If
                      
        End If
      
    End If
  
End Sub

Private Sub DeleteImage(ByVal Target As Range)

    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(Target, shp.TopLeftCell) Is Nothing Then
                shp.Delete
                Exit For
            End If
        End If
    Next shp
  
End Sub

Hope this helps!

Hi Domenic,

It worked perfectly!!!!

Thank again for your time to help me with this code. Much appreciated!

Paul