Hallo,
Ik zit met een probleem die ik niet opgelost krijg.
Heb heb bijgevoegd een voorbeeld document.
De macro haalt via de link die verborgen staat in Kolom B (onder de foto), de foto op, alleen wil ik niet dat hij verbonden blijft met de link, maar dat hij er daadwerkelijk een foto van maak. Wanneer ik de sheet bijvoorbeeld verstuur naar iemand anders verliest hij verbinding met de foto vanwege dat die lokaal staat.
Dus de vraag, hoe krijg ik de macro zo dat hij daadwerkelijk er een foto van maakt.
Ik zit met een probleem die ik niet opgelost krijg.
Heb heb bijgevoegd een voorbeeld document.
De macro haalt via de link die verborgen staat in Kolom B (onder de foto), de foto op, alleen wil ik niet dat hij verbonden blijft met de link, maar dat hij er daadwerkelijk een foto van maak. Wanneer ik de sheet bijvoorbeeld verstuur naar iemand anders verliest hij verbinding met de foto vanwege dat die lokaal staat.
Dus de vraag, hoe krijg ik de macro zo dat hij daadwerkelijk er een foto van maakt.
Code:
Option Explicit
Dim rng As Range
Dim cell As Range
Dim Filename As String
Sub URLPictureInsert()
Dim theShape As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set rng = ActiveSheet.Range("B10:B3000") ' <---- ADJUST THIS
For Each cell In rng
Filename = cell
If InStr(UCase(Filename), "JPG") > 0 Then '<--- ONLY USES JPG'S
ActiveSheet.Pictures.Insert(Filename).Select
Set theShape = Selection.ShapeRange.Item(1)
If theShape Is Nothing Then GoTo isnill
xCol = cell.Column + 0
Set xRg = Cells(cell.Row, xCol)
With theShape
.LockAspectRatio = msoFalse
.Width = 75
.Height = 75
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
isnill:
Set theShape = Nothing
Range("B10").Select
End If
Next
Application.ScreenUpdating = True
Debug.Print "Done " & Now
End Sub
