Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1432to1436
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Speichername aus Zellen zusammensetzen

Speichername aus Zellen zusammensetzen
01.07.2015 10:38:20
Meike
Hallo Zusammen,
ich habe in meinem Exceltool die Möglichkeit mit Klick auf eine Schaltfläche ein PDF zu erzeugen.
Bei Klick soll sich zunächst das "Speichern unter" Fenster öffnen und danach die PDF.
Hier würde ich gern als Speichername einen Vorschlag vorgeben, der sich aus Tabelle "Eingabe" Spalte W15_W11 zusammensetzen soll. (PLZ_Name)
Momentan sieht der Code wie folgt aus und funktioniert auch. Kann mir einer von euch sagen, wo ich hier den vorgeschlagenen Speichername unter bringe? Vielen Lieben Dank.
sonnige Grüße
'ErzeugePDF speichert alle sichtbaren Blätter ausser Blatt "Eingabe" als PDF-Datei
'in das Dateiverzeichnis, das in Eingabe!EG_Pfad enthalten ist.

Sub ErzeugePDF()
Dim intBlatt As Integer, arrBlatt() As String
Dim objSheet As Object
Dim Anzeigen As Boolean
Dim Pfad As String, Datei As String, varDatei
'Status fuer "OpenAfterPublish" nach dem Erzeugen der PDF-Datei setzen
Anzeigen = True
Pfad = ThisWorkbook.Path & "\"
Datei = Range("Eingabe!EG_Datei").Value
varDatei = Application.GetSaveAsFilename(InitialFileName:=Pfad & Datei, _
FileFilter:="PDF (*.pdf),*.pdf", _
Title:="Bitte Ordner\Dateiname der PDF-Datei auswählen/eingeben")
If varDatei = False Then Exit Sub
Pfad = Left(varDatei, InStrRev(varDatei, "\"))
Datei = Mid(varDatei, InStrRev(varDatei, "\") + 1)
'Pruefen, ob die PDF-Datei mit dem vorgesehenen Dateinamen geoeffnet ist
Check_Datei_geoeffnet:
Select Case fncTest_offen(sPath:=Pfad & Datei)
Case 1 'Datei ist geoeffnet
Select Case MsgBox("Die Datei """ & varDatei & """ ist zur Zeit geoeffnet!" & vbLf   _
_
_
& "Bitte Datei erst schliessen und dann OK oder Abbrechen!", _
vbOKCancel, "Blatt als PDF-Datei speichern")
Case vbOK
GoTo Check_Datei_geoeffnet
Case vbCancel
Exit Sub
End Select
Case 2 'Datei gibt es noch nicht
Case 0 'Datei ist geschlossen
End Select
With ThisWorkbook
'Blattnamen der sichtbaren Blätter in Array sammeln
Application.ScreenUpdating = False
For Each objSheet In .Sheets
Select Case objSheet.Name
Case "Eingabe"
'nicht in PDF speichern
Case Else
If objSheet.Visible = True Then
'gruppierte Tränen ausblenden
Call GruppeTraenen_Ein_Aus(wks:=objSheet, strShapeName:="Träne ",  _
bolEin:=False)
'gruppierte Ampeln ausblenden
Call GruppeTraenen_Ein_Aus(wks:=objSheet, strShapeName:="Ampel", bolEin: _
_
=False)
intBlatt = intBlatt + 1
ReDim Preserve arrBlatt(1 To intBlatt)
arrBlatt(intBlatt) = objSheet.Name
End If
End Select
Next
Application.ScreenUpdating = True
If intBlatt > 0 Then
.Sheets(arrBlatt).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=varDatei, _
OpenAfterPublish:=Anzeigen, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
Application.ScreenUpdating = False
'Gruppierung wieder aufheben
.Sheets("Eingabe").Select
For intBlatt = 1 To UBound(arrBlatt)
'gruppierte Tränen ausblenden
Call GruppeTraenen_Ein_Aus(wks:=Sheets(arrBlatt(intBlatt)), strShapeName:="Trä  _
_
ne ", bolEin:=True)
'gruppierte Ampeln ausblenden
Call GruppeTraenen_Ein_Aus(wks:=Sheets(arrBlatt(intBlatt)), strShapeName:=" _
Ampel", bolEin:=True)
Next
Application.ScreenUpdating = True
Else
MsgBox "Keine sichtbaren Blaetter für Ausgabe ins PDF gefunden!"
End If
End With
Exit Sub
Err_Makro3_PDF1:
MsgBox Prompt:="Der Pfad '" & Pfad & "' zum Speichern der PDF-Datei existiert nicht!" &  _
vbNewLine & vbNewLine & _
"Daher keine Speicherung der PDF-Datei --> Abbruch!", _
Buttons:=vbCritical + vbOKOnly, _
Title:="Falscher Dateipfad"
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Speichername aus Zellen zusammensetzen
01.07.2015 22:42:04
Sepp
Hallo Meike,
Datei = Range("Eingabe!EG_Datei").Value & Sheets("Eingabe").Range("W15") & "_" & Sheets("Eingabe").Range("W11")
Gruß Sepp

Anzeige

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige