FejlBehandling

Hvad mener du med, at du kun kan få fejlen en gang?

Du kan vel indlægge en On Error Goto Fejlzone
alle de steder, hvor fejlen kan opstå.

Så vidt jeg lige kan se, så vil programmet kun udføre sætningerne

      ActiveCell.Offset(0, 6).Value = 0
      ActiveCell.Offset(1, 0).Select
      GoTo NæsteVare

hvis fejlen er 3021. hvis der opstår andre fejl afsluttes programmet. Tilføj evt. en Resume Next efter select sætningen.

Nu kan jeg jo ikke se, hvad det er du vil, men måske er det blot "GoTo NæsteVare" du skal placere udenfor "Select case"-sætningen.

Iøvrigt er det vel i overkanten med en Select Case, hvis der kun er en fejlmulighed, der skal selectes.

Jeg har selv løst det, se koden her.

Ja, det er i overkanten at bruge Select Casse på dette tidspunkt, men der er allerede kommet flere til.

Sub Intranetsek()
    Dim DB As Database
    Dim RS As Recordset
    Dim Tom As Long
   
'    Sheets("Dansk Prisliste").Select
'    Range("A1:F200").Select
'    Selection.Copy
'    Sheets("Intranet").Select
'    Range("A1").Select
'    ActiveSheet.Paste
'    Range("A2").Select
   
    Set DB = OpenDatabase("\\annika\db_okono\Access\priser.mdb")
    Set RS = DB.OpenRecordset("T-SekPris")
    Do Until Tom >= 20
        If checkdimssek(RS) Then
            Tom = Tom + 1
        Else
            Tom = 0
        End If
    Loop
End Sub


Function checkdimssek(OverfortRS As Recordset) As Boolean
    Dim ErTom As Boolean
    On Error GoTo FejlZone
    OverfortRS.MoveFirst
    If ActiveCell.Value = "" Then
        ActiveCell.Offset(1, 0).Select
        ErTom = True
    Else
        Do Until ActiveCell.Value = OverfortRS![Varenummer]
            OverfortRS.MoveNext
        Loop
        ActiveCell.Offset(0, 5).Value = OverfortRS![Salgspris]
        ActiveCell.Offset(1, 0).Select
        ErTom = False
    End If
GoTo EndOfFunction
FejlZone:
    Select Case Err
        Case 3021
        ActiveCell.Offset(0, 5).Value = 0
        ActiveCell.Offset(1, 0).Select
        OverfortRS.MoveFirst
        Err.Clear
        ErTom = False
    End Select
EndOfFunction:
    checkdimssek = ErTom
End Function

Så vidt jeg kan se, er der da stadig kun én Case under Select Case sætningen.