Hi,
I need your help to fix this issue. I have a code and this is work on my computer. But now I try to link the picture from the SharePoint to excel macro using the code and path folder.
I try to add the path folder using Sharepoint to excel. But is not work to show the pictures in excel
Here is the example:
here is the code I use
Please help me to fix this code. I try many times but still did not work.
Regards,
I need your help to fix this issue. I have a code and this is work on my computer. But now I try to link the picture from the SharePoint to excel macro using the code and path folder.
I try to add the path folder using Sharepoint to excel. But is not work to show the pictures in excel
Here is the example:
here is the code I use
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
Dim rng As Range, c As Range
Dim img As String, imgName As String
Const filepath As String = "https://li0.sharepoint.com/sites/Lux-Qtr/SC/Stock Pictures/"
Application.ScreenUpdating = False
Set rng = Intersect(Target, Range("C2:C" & Rows.Count))
If Not rng Is Nothing Then
For Each c In rng
With c.Offset(0, -1)
imgName = "PictureAt" & .Address
On Error Resume Next
Me.Shapes(imgName).Delete
On Error GoTo 0
If Dir(filepath & "NOPHOTO.jpg") <> "" Then img = filepath & "NOPHOTO.jpg"
If Dir(filepath & c.Value & ".jpg") <> "" Then img = filepath & c.Value & ".jpg"
If img <> "" Then
Set shp = Me.Shapes.AddPicture(img, msoFalse, msoTrue, .Left, .Top, 200, 200)
shp.Name = imgName
shp.ScaleHeight 1, msoTrue
shp.ScaleWidth 1, msoTrue
shp.LockAspectRatio = msoTrue
shp.Height = c.Cells(1).Height - 4
shp.Left = .Left + ((.Width - shp.Width) / 2)
shp.Top = .Top + ((.Height - shp.Height) / 2)
End If
End With
Next
End If
Application.ScreenUpdating = True
End Sub
Please help me to fix this code. I try many times but still did not work.
Regards,