speicher über Inputbox

Private Sub CommandButton10_Click() Dim strName As String strName = ActiveWorkbook.Name strName = InputBox("Bitte Dateiname angeben:", , strName) If strName = "" Then Exit Sub Application.DisplayAlerts = False ActiveWorkbook.SaveAs strName Application.DisplayAlerts = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton10_Click() Dim strName As String strName = InputBox("Bitte Dateiname angeben:") If strName = ThisWorkbook.Name Then strName = "" MsgBox "Sie müssen einen ANDEREN Namen wählen", vbOKOnly + vbCritical, "Datei Name" End If If strName = "" Then Exit Sub Application.DisplayAlerts = False ActiveWorkbook.SaveAs strName Application.DisplayAlerts = True End Sub

Hallo
Alternativ diese Variante in das Klassenmodul "diese Arbeitsmappe"

Option Explicit

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
        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.Name Then
                    MsgBox "Datei darf nicht unter dem gleichen Namen gespeichert werden", vbCritical + vbOKOnly, "Fehler"
                    GoTo saveExit
                Else
                    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & .SelectedItems(1)
                    Cancel = True
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    saveExit:
    Application.EnableEvents = True
    Exit Sub

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

Dann kannst du mit deinem Commandbutton einfach "ThisWorkbook.Save" auslösen, und der Rest wird über dieses Makro geprüft.
Der Vorteil, jeder andere Speicherversuch wird ebenfalls geprüft
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

speicher über Inputbox

6 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)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread