Hallo, ich habe es nun wie folgt gelöst:

Sub SaveActiveWorkbookAsPDF(control As IRibbonControl)
 Dim pdfFileName As String
    Dim pdfFilePath As String
    Dim pdfFullName As String
    Dim fileExists As Boolean
    Dim userResponse As VbMsgBoxResult
    Dim workbookName As String

    ' Aktive Arbeitsmappe anstelle von ThisWorkbook verwenden
    Dim activeWorkbook As Workbook
    Set activeWorkbook = Application.activeWorkbook

    ' Dateiname und Pfad festlegen
    pdfFilePath = activeWorkbook.Path
    workbookName = activeWorkbook.Name
    pdfFileName = Left(workbookName, InStrRev(workbookName, ".") - 1) ' Entfernen der Dateiendung
    pdfFullName = pdfFilePath & "\" & pdfFileName & ".pdf"

    ' Überprüfen, ob die PDF-Datei bereits existiert
    fileExists = Dir(pdfFullName) <> ""

    If fileExists Then
        ' Warnung, dass die Datei existiert und überschrieben wird
        userResponse = MsgBox("Die PDF-Datei '" & pdfFullName & "' ist bereits vorhanden. Sie wird überschrieben. Möchten Sie fortfahren?", vbYesNo + vbExclamation, "Datei überschreiben?")
        
        If userResponse = vbNo Then
            Exit Sub
        End If
    End If

    ' Überprüfen, ob die PDF-Datei geöffnet ist
    If IsFileOpen(pdfFullName) Then
        MsgBox "Die PDF-Datei '" & pdfFullName & "' ist bereits geöffnet.", vbExclamation
        Exit Sub
    End If

    ' Arbeitsmappe als PDF exportieren und bestehende Datei überschreiben
    On Error Resume Next
    activeWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFullName, Quality:=xlQualityStandard
    If Err.Number <> 0 Then
        MsgBox "Fehler beim Exportieren der PDF-Datei. Bitte überprüfen Sie, ob die Datei geöffnet ist oder ob Sie die richtigen Berechtigungen haben.", vbCritical
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0

    ' PDF-Datei öffnen
    Shell "explorer.exe """ & pdfFullName & "", vbNormalFocus
End Sub



Function IsFileOpen(filePath As String) As Boolean
    On Error Resume Next
    Dim fileNum As Integer

    ' Debugging: Überprüfung, ob die Datei existiert
    If Dir(filePath) = "" Then
        Debug.Print "Datei existiert nicht: " & filePath
        IsFileOpen = False
        Exit Function
    End If

    ' Versuchen, die Datei im "Input"-Modus zu öffnen
    fileNum = FreeFile
    Open filePath For Input Lock Read As #fileNum
    Close #fileNum ' Schließe die Datei sofort, wenn sie geöffnet werden kann

    ' Wenn kein Fehler aufgetreten ist, ist die Datei nicht offen
    IsFileOpen = (Err.Number <> 0)
    Err.Clear ' Fehler zurücksetzen
    On Error GoTo 0
End Function

DANKE für eure Unterstützung!

LG Sabi