How to insert (filenam) as PNG

[Dojorgen]

Hey guys always such great help

this macro works great i found online except for one flaw, it keeps the filenam as a string so when i go back and reopen the workbook it re-pulls all the filenam links. This ends up crashing the server which some folks are not too happy with me about

Is there any way i could import the filenam but have the image populate as say a PNG or something so it does not keep pulling that link?

I tried a few different ways but it does not seem to be working.

Any help would be appreciated....



Sub URLPictureInsert1()
Worksheets("Data Entry").Select
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = True
Set Rng = ActiveSheet.Range("AE2:AE415")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column - 13
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 300
.Height = 75
.Top = xRg.Top + (xRg.Height - .Height)
.Left = xRg.Left + (xRg.Width - .Width)
Selection.Placement = xlMoveAndSize

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.ScaleWidth 0.48, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 299
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 75
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 78
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
End With


lab:
Set Pshp = Nothing
Range("Q2").Select
Next
Application.ScreenUpdating = False
End Sub

 

[Dojorgen]

any help would be appreciated