Thema Datum  Von Nutzer Rating
Antwort
29.10.2024 13:36:31 Sabi
NotSolved
29.10.2024 13:50:20 Gast84226
NotSolved
29.10.2024 13:59:44 Sabi
NotSolved
29.10.2024 16:36:29 Gast7094
NotSolved
29.10.2024 16:47:33 Gast47626
NotSolved
30.10.2024 08:00:38 Sabi
NotSolved
31.10.2024 08:11:21 Sabi
NotSolved
31.10.2024 11:02:31 Alwin Weisangler
NotSolved
Rot Makros und Netzwerklaufwerke...
31.10.2024 12:57:24 Sabi
NotSolved

Ansicht des Beitrags:
Von:
Sabi
Datum:
31.10.2024 12:57:24
Views:
34
Rating: Antwort:
  Ja
Thema:
Makros und Netzwerklaufwerke...

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
29.10.2024 13:36:31 Sabi
NotSolved
29.10.2024 13:50:20 Gast84226
NotSolved
29.10.2024 13:59:44 Sabi
NotSolved
29.10.2024 16:36:29 Gast7094
NotSolved
29.10.2024 16:47:33 Gast47626
NotSolved
30.10.2024 08:00:38 Sabi
NotSolved
31.10.2024 08:11:21 Sabi
NotSolved
31.10.2024 11:02:31 Alwin Weisangler
NotSolved
Rot Makros und Netzwerklaufwerke...
31.10.2024 12:57:24 Sabi
NotSolved