Hey guys always such great help![Smile :) :)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f642.png)
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![Mad :mad: :mad:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f621.png)
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....![Confused :confused: :confused:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f615.png)
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
![Smile :) :)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f642.png)
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
![Mad :mad: :mad:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f621.png)
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....
![Confused :confused: :confused:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f615.png)
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