Hallo zusammen,
ich habe in einer Excel-Datei einen Button eingefügt, der mir nach Klick eine Datei nach einem Namen aus Zelle D24 unter einem definiertem Pfad abspeichert.
Falls die Zelle leer ist, taucht ein Hinweis auf.
Der Code hierzu lautet:
Code:
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Public Sub Speichern()
If Cells(24, 4).Value = "" Then
MsgBox "CS-Meldungsnummer noch nicht eingetragen!!!"
Exit Sub
End If
Dim strPath As String, strFile As String
strFile = Range("D24").Text & ".xlsm"
strPath = "S:\Dokumentenverwaltung\12_Auftragsablage\Servo\" & Format(Date, "yyyy") & "\" & Cells(24, 4).Text & "\"
If CBool(MakeSureDirectoryPathExists(strPath)) Then
ThisWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=52
Else
MsgBox "Fehler beim anlegen des Pfades: " & strPath
End If
End Sub
Gibt es nun die Möglichkeit, wenn zB. in Zelle A1 und B1 ein "x" steht, die Datei bei Klick auf den Button unter einem anderen Dateinamen abzuspeichern!? (am Ende des Dateinamens noch _Stufe1.xlsm)
Ich benötige das ganze 4 mal für die folgenden Gegebenheiten:
A1 und B1 = "x" -> Dateiname Ende + _Stufe1.xlsm
A1 und B2 = "x" -> Dateiname Ende + _Stufe2.xlsm
A1 und B3 = "x" -> Dateiname Ende + _Stufe3.xlsm
A1 und B4 = "x" -> Dateiname Ende + _Stufe4.xlsm
Kann mir jemand helfen wie ich hier meinen Code umbauen muss!?
Experimentiere erst seit kurzem mit VBA und komme einfach nicht drauf...
Vielen Dank schon mal für jede Hilfe!
Liebe Grüße
[
attachment=5371]
Hallo Steffl und vielen Dank schonmal,
leider funktioniert der Code so nicht, und folgende Meldung taucht auf:
Fehler beim kompilieren:
Bekanntes Argument nicht gefunden
habe dir mal eine Beispieldatei angehängt vll. wird es damit ersichtlicher. (Der Code befindet sich in Modul 2)
Liebe Grüße
Hallo,
schreibe anstatt filenname filename (war Tippfehler :22: ).
Ach super! Funktioniert 1A, vielen vielen Dank dir! :28: :28: :28:
Nochmal eine Frage zu diesem Code,
wie kann ich ihn abändern damit die Datei nicht automatisch ins angegebene Verzeichnis gespeichert wird,
sondern sich in diesem nur das Speichern unter Fenster öffnet und der Dateiname nur als Vorschlag dient und noch abgeändert werden kann?
Außerdem soll die Datei eine Pdf sein
Geht das so?
Viel Dank nochmal!
Code:
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Public Sub Speichern()
Dim strPath As String, strFile As String
Dim lngCounter As Long
strFile = Range("D11").Text & "_" & Format(Date, "yyyymmdd") & ".xlsm"
strPath = "S:\Dokumentenverwaltung\12_Auftragsablage\Pumpen\" & Format(Date, "yyyy") & "\" & Cells(11, 4).Text & "\"
If CBool(MakeSureDirectoryPathExists(strPath)) Then
If Range("D14:D14").Value = "X" And Range("G14:G14").Value = "X" Then
ThisWorkbook.SaveAs Filename:=strPath & Range("D11").Text & "_1Stufe" & "_" & Format(Date, "yyyymmdd"), FileFormat:=52
ElseIf Range("D14:D14").Value = "X" And Range("G15:G15").Value = "X" Then
ThisWorkbook.SaveAs Filename:=strPath & Range("D11").Text & "_2Stufe" & "_" & Format(Date, "yyyymmdd"), FileFormat:=52
ElseIf Range("D14:D14").Value = "X" And Range("Q14:Q14").Value = "X" Then
ThisWorkbook.SaveAs Filename:=strPath & Range("D11").Text & "_3Stufe" & "_" & Format(Date, "yyyymmdd"), FileFormat:=52
ElseIf Range("D14:D14").Value = "X" And Range("Q15:Q15").Value = "X" Then
ThisWorkbook.SaveAs Filename:=strPath & Range("D11").Text & "_4Stufe" & "_" & Format(Date, "yyyymmdd"), FileFormat:=52
Else
ThisWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=52
End If
Else
MsgBox "Fehler beim anlegen des Pfades: " & strPath
End If
End Sub
Hallo,
wegen dem PDF: Bei der SaveAs-Methode kannst Du Pdf nicht als Fileformat auswählen, das geht so
PHP-Code:
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strFile
jetzt nur für den Else-Teil, die anderen musst du anpassen. Bezüglich der anderen Geschichte: Keine Ahnung.
Hi Steffl,
habe mir folgenden Code abgeändert und er funktioniert so weit wie er soll,
jedoch lässt sich die .pdf-Datei anschließend nicht öffnen bzw. wird als falsches Dateiformat abgespeichert.
Wo liegt hier mein Fehler?
Gruß Sebbi
Code:
Sub Speichern_unter()
Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
Verzeichnis = "U:\" 'Verzeichnis-Vorschlag
Datei = "00" & Range("G24") & ".pdf" 'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt
End Sub
Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="PDF Dateien (*.pdf),*.pdf*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
End Function
Hallo,
ich zitier mich mal selber
(07.06.2016, 10:34)Steffl schrieb: [ -> ]wegen dem PDF: Bei der SaveAs-Methode kannst Du Pdf nicht als Fileformat auswählen, das geht so
PHP-Code:
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strFile
Ok hab ich verstanden,
habe einen neuen einfacheren Code für die Funktion gefunden der soweit funktioniert,
allerdings weiß ich nicht wo ich hier einen Pfad angeben kann der dann als Speicherort vorgeschlagen wird.
Das ist das einzigste was mir jetzt noch fehlt.
Gruß Sebbi
Code:
Option Explicit
Sub saveAsPDF()
ChDir "U:\"
Dim X
X = Application.GetSaveAsFilename(InitialFileName:=Range("K24").Text & ".pdf", _
FileFilter:="PDF files, *.pdf", _
Title:="Save PDF File")
If TypeName(X) = "Boolean" Then
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=X, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End Sub