Nach Dialog Save (Abbrechen)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton1_Click() Dim DateiAlt As String Dim DateiNeu As String Dim x As Variant DateiAlt = ActiveWorkbook.Name x = Application.Dialogs(xlDialogSaveAs).Show If x = True Then ElseIf DateiNeu = DateiAlt Then MsgBox "gleicher Name!" Exit Sub End If Worksheets("Tabelle1").Range("b4").ClearContents 'ist nur als Test im Moment Exit Sub End Sub

Hallo
Wahrscheinlich, weil du die Mappe noch nicht gespeichert hast.
Du hast eine Mappe1 offen und rufst den Dialog auf.
.SelectedItems(1) gibt in diesem Fall "Mappe1.xls" zurück und Thisworkbook.Name "Mappe1"
If .SelectedItems(1) = .InitialFileName Then
kann nur funktionieren, wenn der Name unterschiedlich zur Vorgabe ist, aber dann kann unter dem gleichen Mappennamen gespeichert werden.!
Das von dir beschriebene Problem kann auftreten, wenn aus einer Vorlage heraus gespeichert werden soll.
Umgehen kannst du das mit einer Abfrage vorher
If right(thisworkbook.name,3) = "xls" then
...Speicherroutine wie oben beschrieben aufrufen
Else
... Speicherrouting aufrufen ohne anschliessende Prüfung des Dateinamens
End If
Für EXCEL 2007 muss das noch unterschieden werden
If val(application.Version) = 12 Then
If Left(right(thisworkbook.name,4),3) = "xls" then
...Speicherroutine wie oben beschrieben aufrufen
Else
... Speicherrouting aufrufen ohne anschliessende Prüfung des Dateinamens
End If
ElseIf Val(Application.Version) < 12 Then
...Speichern wie oben
End If
weil E2007 die Dateinamen mit 4 Buchstaben in der Erweiterung abspeichert,... im Normalfall, die zweite ElseIf Abfrage weil im Kompatibilitätsmodus gespeichert werden kann
Gruss Rainer

Hallo
"...ferner-kann ich die meldung, dass die datei schon existiert unterbinden?..."
Zu diesem Zeitpunkt nicht, das wäre in diesem Falle ein erster Hinweis.
Der Dialog speichert zu diesem Zeitpunkt noch nicht, ... sollte zumindest :-)
Hier mal eine Variante. Die Prüfung müsste mit FullName anstelle von Name gemacht werden.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim myFile As FileDialog, x
    Set myFile = Application.FileDialog(msoFileDialogSaveAs)
    On Error GoTo errCheck
    If InStr(1, ThisWorkbook.Name, "xls") > 0 Then
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        If CurDir <> ThisWorkbook.Path Then
            ChDrive Left(ThisWorkbook.Path, 1)
            ChDir ThisWorkbook.Path
        End If
        With myFile
            .ButtonName = "Neu Speichern als..."
            .Title = "Anderen Dateinamen verwenden"
            .InitialFileName = ""
            ' Alternativ mit Datum und Dateiname
            '.InitialFileName = Date & "_" & ThisWorkbook.Name
            If .Show = -1 Then
                If .SelectedItems(1) = ThisWorkbook.FullName Then
                    MsgBox "Datei darf nicht unter dem gleichen Namen gespeichert werden", vbCritical + vbOKOnly, "Fehler"
                    Cancel = True
                    GoTo saveExit
                Else
                    MsgBox .SelectedItems(1)
                    ThisWorkbook.SaveAs .SelectedItems(1)
                    Cancel = True
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    saveExit:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Exit Sub

    errCheck:
    MsgBox Err.Number & "; " & Err.Description, vbOKOnly + vbCritical, "Fehler"
    Resume saveExit
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nach Dialog Save (Abbrechen)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread