Problem med vba i excel - Loadpicture fejler.

Hej med jer.

Jeg har nedenstående kode, hvor Følgende linie fejl hvis billedet fylder mere end 2 mb. Nogle forslag til hvorfor det sker?

Jeg har nu sat noget errorhandler på, så den springer over store billeder i stedet for at vise fejlen ved hvert eneste store billede. 


//Fejler
Set p = LoadPicture(billede)


//Alt kode
Public Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim myPict As Picture
    Dim myCell As Range
    Dim link As String
    Dim mySheet As Worksheet
    'Dim Target As Range
    Dim r As Integer
    Dim c As Integer
    Dim Myrange As Range
    Dim billede As String
    Dim h As Double
    Dim b As Double
    Dim forskel As Double
    Dim forskelprocent As Double
    Dim p As StdPicture
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("E1:G10000")


    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
          Is Nothing Then
          billede = Target.Value
          If Dir(billede) = "" Then
                Target.Value = ""
          End If
         
          billede = Target.Value
                     
          If billede <> "" Then
                   
          On Error GoTo ErrTrap
          Set p = LoadPicture(billede)
          If p.Width > 55000 Then
                  forskel = p.Width - 55000
                  forskelprocent = forskel / p.Width
                  b = 100 - (forskelprocent * 100)
                  h = b
          Else
                h = -1
                b = -1
          End If
          ' Targetrow = 13
          ' Targetcolumn = 16
          r = Target.Row
          c = Target.Column
          Columns("B").ColumnWidth = 40
          Target.RowHeight = 100
          Columns("C").ColumnWidth = 40
          Columns("D").ColumnWidth = 40
         
          If c = 5 Then
                ActiveSheet.Cells(r, 2).Select
                ActiveSheet.Cells(r, 2).Activate
          ElseIf c = 6 Then
         
                ActiveSheet.Cells(r, 3).Select
                ActiveSheet.Cells(r, 3).Activate
          ElseIf c = 7 Then
                ActiveSheet.Cells(r, 4).Select
                ActiveSheet.Cells(r, 4).Activate
          End If
         
         
         
          Set Myrange = Range(ActiveCell, ActiveCell.Offset(0, 0))
          Myrange.Select
                     
            If Application.Version <= 12 Then
            With ActiveCell
                Set myPict = .Parent.Pictures.Insert(billede)
                myPict.Top = .Top
                myPict.Left = .Left
                myPict.Placement = xlMoveAndSize
            End With
            Else
                           
            ActiveSheet.Shapes.AddPicture(billede _
            , False, True, -1, -1, b, h).Select
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue
                .Top = Myrange.Cells.Top
                .Left = Myrange.Cells.Left
                .Width = Myrange.Cells.Width
                .Height = Myrange.Cells.Height
            End With
            End If
            'ActiveSheet.Cells(Target.Row, Target.Column).Select
            'ActiveSheet.Cells(Target.Row, Target.Column).Activate
            Target.Clear
            Exit Sub
ErrTrap:
           
         
      End If
    End If
End Sub