automatische Onderbreking in code

[harolda1980]

Telkens wanneer ik deze code uitvoer krijg ik een onderbrekingsmodus op de volgende onderdelen.
Terwijl deze code normaal altijd naar behoren werkte. Heeft iemand een idee?

eerste regel waarop hij onderbreekt

For Each vrtSelectedItem In .SelectedItems

tweede regel waarop hij onderbreekt

    Set loadbook = Nothing

Complete code:

Private Sub Regelsinladen_chefkok()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim loadbook
Dim lv_item

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        If .Show = -1 Then
            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems
                Workbooks.Open vrtSelectedItem
                Set loadbook = Application.ActiveWorkbook
                lv_item = 1
                    With loadbook.Sheets("blad1")
                        Do
                            If .Cells(Regelstart, kolomstart).Value <> "" Then
                                lstview.ListItems.Add , , .Cells(Regelstart, kolomstart).Value
                                lstview.ListItems(lv_item).ListSubItems.Add , , .Cells(Regelstart, kolomstart + 1).Value
                                lstview.ListItems(lv_item).ListSubItems.Add , , .Cells(Regelstart, kolomstart + 3).Value
                            Else
                                Exit Do
                            End If
                            lv_item = lv_item + 1
                            Regelstart = Regelstart + 1
                        Loop
                    End With
                Exit For
            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With
    Set fd = Nothing
    loadbook.Close False
    Set loadbook = Nothing
    txtregels.Value = lv_item
    opchefkok.Value = False
End Sub

 

[snb]

Mijn voorkeur:

With Application.FileDialog(msoFileDialogFilePicker)
    .Show
    For Each it In .SelectedItems
        with getobject(it)
          '    doe wat
          .close true
        end with
    Next
 End With

 

[harolda1980]

Inderdaad een snelle doelmatige code. alleen bij de For each regel krijg ik nog steeds de volgende foutmelding:
De uitvoering van de programmacode is onderbroken. En ik heb zelf geen onderbrekingen erin staan.

Private Sub Regelsinladen_chefkok()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim loadbook
Dim lv_item
Dim IT
    lv_item = 1
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        For Each IT In .SelectedItems
            With GetObject(IT)
                            Do
                                If .Sheets("BLAD1").Cells(Regelstart, kolomstart).Value <> "" Then
                                    lstview.ListItems.Add , , .Sheets("BLAD1").Cells(Regelstart, kolomstart).Value
                                    lstview.ListItems(lv_item).ListSubItems.Add , , .Sheets("BLAD1").Cells(Regelstart, kolomstart + 1).Value
                                    lstview.ListItems(lv_item).ListSubItems.Add , , .Sheets("BLAD1").Cells(Regelstart, kolomstart + 3).Value
                                Else
                                    Exit Do
                                End If
                                lv_item = lv_item + 1
                                Regelstart = Regelstart + 1
                            Loop
              .Close True
            End With
        Next
     End With
    txtregels.Value = lv_item
    opchefkok.Value = False
    On Error GoTo 0
End Sub

 

[snb]

Het lijkt me handig om een of meer bestanden in het scherm te selecteren

 

[harolda1980]

Dat heb ik dus gedaan en dan begint hij bij de for each die foutmelding te geven. Wanneer ik hem handmatig (f8) verder laat gaan werkt hij wel.

 

[enijhuis]

Hoi Harolda,

Ongelooflijk maar waar:
Wanneer het uitvoeren van vba code soms zomaar 'pauzeert' en een specifieke regel code highlight dan is de oplossing om je computer te rebooten...

 

[harolda1980]

Ongelofelijk maar waar.. Want de foutmelding is nu weg!
En dat is inderdaad de oplossing!

 

[enijhuis]

Dat zei ik toch...
Mickeysoft :thumb: