Avatar billede jesperthomsen1980 Nybegynder
17. marts 2014 - 08:58

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
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester