Foutmelding verhelpen in VBA

[WRD Frank]

Ik heb in VBA de onderstaande formule staan.
met deze formule opent er een venster zodat er een afbeelding kan worden ingevoegd.
Echter wanneer er op 'esc' of op 'annuleren' wordt gedrukt verschijnt er een foutmelding.

Is er een extra code die bijgevoegd kan worden die het mogelijk maakt om de taak te annuleren zonder dat de foutmelding te zien is?

Sub Fotoinvoegen()
ScreenUpdating = False
fileToOpen = Application _
.GetOpenFilename("JPEG-Afbeelding (*.jpg), *.jpg")
If fileToOpen <> False Then ActiveSheet.Pictures.Insert(fileToOpen).Select
     With Selection
'===============foto verhouding vast houden
    .ShapeRange.LockAspectRatio = msoTrue
  ' .Height = 163
    .Width = 183
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    
End With

End Sub

 

[OctaFish]

Met FileDialog heb je meer controle.

Function BestandOpzoeken(Optional Pad As String) As String
Dim dlgPicker As FileDialog
Dim sType() As String, sFile As String
Dim tmp As String, sPad As String
Dim bCheck As Boolean
Dim vrtSelectedItem As Variant

    On Error GoTo Hell
    Set dlgPicker = Application.FileDialog(msoFileDialogFilePicker)
    With dlgPicker
        .Title = "Selecteer een bestand." 'De titel voor het venster
        .InitialFileName = sPad      'Waar moet het venster beginnen?
        With .Filters
            .Clear
            .Add "Microsoft Word", "*.doc; *.docx; *.docm", 1       'Beperk de bestandstypes tot .doc
            .Add "Microsoft Excel", "*.xls; *.xlsx; *.xlsm", 2      'Beperk de bestandstypes tot .xls
            .Add "Adobe Reader", "*.pdf", 3                         'Beperk de bestandstypes tot .pdf"
            .Add "Afbeeldingen", "*.jpg; *.jpeg; *.png", 4          'Beperk de bestandstypes tot afbeeldingen
            .Add "Alles", "*.*", 5                                  'Geen Beperkingen op bestandstype"
        End With
        .FilterIndex = 1
        ''.AllowMultiSelect = True                   'Slechts ??n bestand kiezen toegestaan
        .AllowMultiSelect = False                   'Slechts ??n bestand kiezen toegestaan
        .InitialView = msoFileDialogViewList        'Bepaal weergave
        If .Show = -1 Then                          'Bepaal of gebruiker op OK-knop heeft geklikt.
''            Als .AllowMultiSelect = True is ingegesteld, door de selectie loopen
''            For Each vrtSelectedItem In .SelectedItems
''                If sFile <> "" Then sFile = sFile & ";"
''                sFile = sFile & vrtSelectedItem
''            Next
''            sFile = .SelectedItems.Item(1)      'String wordt gevuld met geselecteerde bestand
            sFile = .SelectedItems(1)           'String wordt gevuld met geselecteerde bestand
        Else
            MsgBox "Er is op <Annuleren> gedrukt..."
            BestandOpzoeken = "Annuleren"
            GoTo Hell
        End If
    End With
    BestandOpzoeken = sFile
    
Hell:
    Set dlgPicker = Nothing

End Function

Sub test()
    BestandOpzoeken
End Sub

 

[Warme bakkertje]

Zonder afbreuk te doen aan de inbreng van Octafish is de oplossing vrij simpel.

Sub Fotoinvoegen()
    fileToOpen = Application _
        .GetOpenFilename("JPEG-Afbeelding (*.jpg), *.jpg")
    If fileToOpen <> False Then
        application.ScreenUpdating = False
        With ActiveSheet.Pictures.Insert(fileToOpen)
'===============foto verhouding vast houden
            .ShapeRange.LockAspectRatio = msoTrue
            '.Height = 163
            .Width = 183
            .Top = ActiveCell.Top
            .Left = ActiveCell.Left
        End With
        application.ScreenUpdating = True
    End If
End Sub

 

[snb]

Waarbij de methode

activesheet.shapes.addpicture

nog simpeler is.

 

[WRD Frank]

Helemaal bedankt voor de reacties.
Heb uit eindelijk gekozen voor de optie van "Warme bakkertje".
Vooral omdat die code lekker kort is, maar tevens omdat ik vba niet 100% onder de knie heb.
Dan is een kortere code prettiger en weet ik wat er wordt weergegeven.