Office: (Office 2016) aktuelles Tabellenblatt als pdf speichern

Hallo zusammen

Ich möchte gerne mit Hilfe eines Buttons das jeweils aktuelle Tabellenblatt, auf dem der Button angebracht ist, als pdf speichern. Dabei soll der Speicherort immer neu gewählt werden können und nicht schon fix hinterlegt sein.

Kennt jemand einen Code, der das löst?

Vielen Dank für eure Unterstützung.

 

Hallo,

in der beiliegenden Excel-Datei ist im allgemeinen Codemodul "Modul1" das Makro "Speichern_AktBlatt_PDF" enthalten.
Mit dem Klick auf den Button im Arbeitsblatt "Tabelle1" kann dieses Makro aufgerufen werden.
Es erscheint ein Dateiauswahl-Dialog für "Speichern unter..." mit einem Dateifilter für PDF-Dateien.
Man kann das Verzeichnis auswählen, wobei das erste angezeigte Verzeichnis dasjenige ist, in dem sich diese Excel-Datei befindet. Ferner muss natürlich ein Dateiname festgelegt werden.
Gespeichert im PDF-Format wird nur das Arbeitsblatt, in dem sich der Button befindet, jedoch ohne den Button.

Code:

Option Explicit

Sub Speichern_AktBlatt_PDF()
'
    Dim j As Long
'
    'Dateidialog für "Speichern unter..." aufrufen:
    With Application.FileDialog(msoFileDialogSaveAs)
       .AllowMultiSelect = False
       .InitialView = msoFileDialogViewDetails
       .InitialFileName = ActiveWorkbook.Path
       .Title = "Arbeitsblatt als PDF speichern"
       .ButtonName = "PDF speichern"
     
       'Dateifilter für PDF-Dateien auswählen:
       For j = 1 To .Filters.Count
         If UCase$(.Filters(j).Extensions) Like "*.PDF*" Then
           .FilterIndex = j: Exit For
         End If
       Next j
     
       If .Show Then
          'Falls Button "PDF speichern" geklickt wurde:
          ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                      Filename:=.SelectedItems(1), _
                      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                      IgnorePrintAreas:=False, OpenAfterPublish:=False
       Else
          'Falls Button "Abbrechen" geklickt wurde
       End If
     
    End With

End Sub

 

Hallo,

ich habe im Makro noch 2 kleine Ergänzungen gemacht.