Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1128to1132
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1128to1132
1128to1132
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datei speichern...

Datei speichern...
edie
Hallo zusammen,
habe mir das nachfolgende Makro, durch die Recherche, zusammengestellt.
Dabei wird ein Ordner angelegt, wenn nicht vorhanden, und die Datei sollte
gespeichert werden.
Leider funktioniert das speichern nicht, und zwar keine von den 3 Optionen. Wo liegt der Fehler?
With ActiveWorkbook
1.
'.SaveAs strFolder
'2
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
'3.
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"
End With
Hier das Makro:
Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value
If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If
strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper & "_" & sDruck & ".xls"
If Dir(strFolder, vbDirectory)  "" Then
Exit Sub
Else
If MsgBox("Das Verzeichnis existiert nicht, " & _
vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If
MkDir strFolder
With ActiveWorkbook
'.SaveAs strFolder
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12")  _
& ".xls"
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"
End With
End Sub

Hat jemand eine Idee und kann helfen?
Vorab schon jetzt vielen Dank.
Grüße

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Datei speichern...
18.01.2010 12:51:00
MichaV
Hallo,
wäre schön gewesen wenn Du geschrieben hättest wo es den Fehler gibt.
Versuch mal diese kleine Änderung:
strFolder = ThisWorkbook.Path & "\Messwerte\"
strFilename = sTemper & "_" & sDruck & ".xls"
If Dir(strFolder, vbDirectory) "" Then
Exit Sub
Else
If MsgBox("Das Verzeichnis existiert nicht, " & _
vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If
MkDir strFolder
With ActiveWorkbook
.SaveAs strFolder & strFilename
Gruss- Micha
AW: Datei speichern...
18.01.2010 13:22:33
edie
Hallo MichaV,
danke für die Hilfe, die Excel-Datei wird leider nicht im neu angelegten Ordner gespeichert,
sondern auf der gleichen Ebene wie der Ordner /Messwerte/.
Die Idee war wie Folgt: Im Ordner /Messwerte/ einen neuen Ordner anlegen, wenn noch
nicht vorhanden, mit dem Name aus Zelle K10. Danach die Excel-Datei in den neu erstellten
bzw. bereits vorhandenen (Name wie Zelle K10) zu speichern. Die Excel-Datei sollte dabei
den Name aus den Zellen K10 und K12 bekommen.
Hier mein angepasster Code:
Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value
If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If
'strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper & "_" & sDruck & ".xls"
strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper  ""
strFilename = sTemper & "_" & sDruck & ".xls"
If Dir(strFolder, vbDirectory)  "" Then
Exit Sub
Else
If MsgBox("Das Verzeichnis existiert nicht, " & _
vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If
MkDir strFolder
With ActiveWorkbook
.SaveAs strFolder & strFilename
End With
End Sub
Vielen Dank im Voraus.
Grüße
Anzeige
AW: Datei speichern...
18.01.2010 13:51:14
Armin
Hallo namenloser,
brauchst Du die Abfrage zwingend? Ansonsten kann man die auch weglassen.
Die "Dir" Funktion ist so falsch. Wenn Du nach einem Verzeichnis fragen willst, muss strFolder auch ein Verzeichnis beinhalten. Bei Dir incl. File.
So funktioniert der Code wenn Du nicht zwingend eine Abfrage benötigst.
Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
Dim StrPath As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value
StrPath = ThisWorkbook.Path & "\Messwerte\" & sTemper
NeurOrdner (StrPath)
If Right(StrPath, 1)  "\" Then StrPath = StrPath & "\"
strFolder = StrPath & "_" & sDruck & ".xls"
With ActiveWorkbook
.SaveAs strFolder
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12")  _
_
& ".xls"
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"
End With
End Sub


Sub NeurOrdner(Ordner As String)
On Error Resume Next
MkDir Ordner
End Sub

LG Armin
Anzeige
AW: Datei speichern...
18.01.2010 14:09:45
edie
Hallo Armin,
eine Abfrage, ob der Ordner schon existiert wäre eine schöne Sache, zumal ich nicht
weiß im Vorhinein den Name das Ordners. Muss voll weiter testen. Mache mir aber
keine große Hoffnung.
Grüße-edie
AW: Datei speichern...
18.01.2010 15:33:20
edie
Hallo Armin,
so funktioniert es in Moment:
Sub testlauf()
Dim strFolder As String
strFolder = ThisWorkbook.Path & "\Messwerte\" & ActiveSheet.Range("K10")
If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If
Application.DisplayAlerts = False
With ActiveWorkbook
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
.SaveAs Filename:=strFolder _
& "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
.Close
End With
Application.DisplayAlerts = True
End Sub
Nur mal eine Frage: Weißt Du zufällig wie man z.B. ein Einzelblatt speichern kann?
Wäre schön, wenn man hier, nicht die ganze Excel-Datei sondern nur die "Tabbelle1" speichern könnte.
Vielen Dank für die Hilfe.
Grüße-edie
Anzeige
AW: Datei speichern...
19.01.2010 08:48:15
Armin
Hallo edie,
ja das weis ich. Aber da muss man natürlich erst etwas klären. Wann soll den das speichern erfolgen?
Nach welchem Event? Oder Button oder oder. Also man kann "fasst alles" mit Excel realisieren.
Also am besten wäre es Du stellst eine Mustermappe zur Verfügung, da geht das erfahrungsgemäs am besten. Wenn Du die nicht ins Forum stellen willst kannst /willst, auch per Mail direkt.
War gestern leider nicht mehr online.
LG Armin
AW: Datei speichern...
19.01.2010 09:12:31
edie
Hallo Armin,
sehr nett von Dir, dass Du noch einmal im Thread nachgeschaut hast. Danke.
Ich habe kräftig recherchiert und rumgebastelt und das kam heraus:
Sub Tets() 'Speichern
Dim Pfad As String
Dim sPrüf As String
Dim DateiName As String
Dim wb As Workbook
Dim fn, vorgabe As String
Pfad = ThisWorkbook.Path & "\Messwerte\" & ActiveSheet.Range("K10")
sPrüf = Dir(Pfad, vbDirectory)
On Error GoTo errhandler
If sPrüf = "" Then
MkDir (Pfad)
End If
DateiName = Pfad & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets("Rohdaten").Range("A3:M25").Copy 'Bereich
Workbooks.Add
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
With Columns
.AutoFit
End With
Application.GoTo reference:=Range("A2"), Scroll:=True
ActiveWorkbook.SaveAs (DateiName)
ActiveWorkbook.Close
MsgBox ("Die Daten wurden erfolgreich nach " & Pfad & " exportiert und unter dem Namen " & _
DateiName & " gespeichert!")
Exit Sub
errhandler:
MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Eigentlich funktioniert es, aber zum Optimieren gibt es immer was.
Vielen Dank für die Geduld.
Grüße-edie
Anzeige
AW: Datei speichern...
19.01.2010 10:03:09
Armin
Hallo edie,
wenns klappt ist es ja ok. Es ist nicht so, dass ich zuviel Zeit habe.
LG Armin

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige