Office: (Office 2016) VBA, Speichern unter xlsx und pdf

Hallo Gemeinde,

sitze etwas länger daran und irgendwie komme ich nicht weiter.

Ich hab eine Datei die aus 3 Tabellen besteht. In Tab 1&2 werden Daten eingegeben, Tabelle 3 ist die Ausgabe. Aktuell wird der Dateiname aus 3 Zellen in Tabelle 2 erzeugt, das klappt auch alles. Jetzt soll zusätzlich Tabelle 3 als PDF abgespeichert werden. Bisher wurde das "von Hand" gemacht, jetzt möchte ich, dass das vom Script automatisch erledigt wird. Dass der Ausgabepfad abgefragt wird ist korrekt, da sich dieser jedesmal ändert. Danach soll aber das PDF in den selben Verzeichniss wie zuvor die Datei, ohne Rückfrage, abgespeichert werden. Gespeichert werden soll Tabelle 1-3 als xlsm und Tabelle 3 als pdf.
Bisher sieht der Code so aus:

Code:

Sub Speichern()
'
' Dateiname aus Eingabedaten generieren und speichern
' MJ
'

On Error GoTo Save_Error

  Set objSheet = ActiveWorkbook.Sheets("Eingabe")
  Set objNameCell1 = objSheet.Range("B5")  'Service_Order
  Set objNameCell2 = objSheet.Range("D18") 'Seriennummer
  Set objNameCell3 = objSheet.Range("B6")  'Laufende-Nummer
  strSeparator = "_"  'Unterstrich

  If IsEmpty(objNameCell1) Or IsEmpty(objNameCell2) Or IsEmpty(objNameCell3) Then
    MsgBox "Eine der Zellen für die Namensvergabe ist leer..."
  Else
     
     strFilename = CStr(objNameCell1.Value) & _
        strSeparator & _
        CStr(objNameCell2.Value) & _
        strSeparator & _
        CStr(objNameCell3.Value)
    File = Application.GetSaveAsFilename(InitialFileName:=strFilename, FileFilter:="Microsoft Excel-Arbeitsmappe mit Makros " & _
        "(*.xlsm),*.xlsm")
    If File <> False Then
      ThisWorkbook.SaveAs Filename:=File
    End If
   End If
  
Save_End:
  Set objNameCell2 = Nothing
  Set objNameCell1 = Nothing
  Set objNameCell3 = Nothing
  Set objSheet = Nothing
  Exit Sub
Save_Error:
  MsgBox "Die Datei konnte nicht gespeichert werden!" & _
      String(2, vbCr) & _
      "Fehlernummer " & Err.Number & vbCr & _
      "Grund: " & Err.Description, _
      Buttons:=vbCritical
  Resume Save_End

Ich bekomme es irgendiwe nicht hin, dass der den vorherigen Ordner und Dateinamen beim exportieren übernimmt...
Danke schon mal im voraus!
lg

 

Hola,

nicht das noch jemand unnötig arbeitet....

http://www.ms-office-forum.net/forum/showthread.php?t=351508

Gruß,
steve1da