VBA Speichern unter
Bernd
habe ein Problem, das ich leider selbst nicht lösen kann. Habe schon versucht etwas zu basteln, aber aus meiner Sicht ist dies alles andere als optimal. Außerdem funktioniert es nicht so wie ich es mir vorstelle.
Also: Eine Exceldatei soll, nachdem in dieser etwas verändert wurde, beim Speichervorgang das "Speichern unter"-Fenster öffnen. Als Dateityp soll "Microsoft Office Excel-Arbeitsmappe (*.xls) eingestellt sein, damit man bei der Vergabe eines Dateinamens nicht noch die Endung eingeben muss. Nachdem der User einen Dateinamen vergeben hat, soll vorher geprüft werden, ob der Dateiname maximal 40 Zeichen lang ist. Ist der Dateiname länger, dann sollte eine entsprechende Meldung kommen, dass der Dateiname zu lang ist und so nicht gespeichert werden kann. Ist der Dateiname Achso, noch etwas habe ich vergessen. Als Pfad für die neue Datei (speichern unter) soll immer der Pfad der Ursprungsdatei genommen werden.
Wäre nett, wenn jemand eine Lösung hat! Mein Versuch sieht so aus:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strName As String
Dim pfad As String
'On Error GoTo errHandler
Application.Dialogs(xlDialogSaveAs).Show ("Maximal 40 Zeichen")
pfad = ThisWorkbook.Path
strName = Application.GetSaveAsFilename (Excel Dateien (*.xls), *.xls)
If Len(fFilename(strName)) > 40 Then
MsgBox fFilename(strName)
MsgBox "Dateiname zu lang"
Cancel = True
Else
Application.EnableEvents = False
ThisWorkbook.SaveAs strName, FileFormat:=xlNormal
Application.EnableEvents = True
End If
'errHandler:
'Application.EnableEvents = True
'Cancel = True
End Sub
Public Function fFilename(DateinameMitPfad As String)
fFilename = Mid(DateinameMitPfad, InStrRev(DateinameMitPfad, "\", -1) + 1)
End Function
Gruß
Bernd