beim Start - speichern unter | HERBERS Excel Forum

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus,
bevor noch jemand seinen Senf dazu gibt. Hier die korregierte Version.
Heist aber nicht, das nicht noch jemand einen Fehler findet.

Private Sub Workbook_Open()
Dim strDatNam As String
Dim intZähler As Integer
Dim bolsave As Boolean
                        bolsave = True
If ThisWorkbook.Name <> "leer.xls" Then Exit Sub
    Do
        strDatNam = Application.InputBox("Bitte geben Sie einen Dateinamen an", "Dateinamen")
            If strDatNam = "" Then
                MsgBox "Ein Fehler wurde verursacht !" & Chr(10) _
                       & "Sie haben keinen Dateinamen angegeben !" & Chr(10) _
                        & "Vorgang wird wiederholt !!!"
            Else
            If strDatNam = "Falsch" Then
            'Hier musst du entscheiden was geschehen soll, wenn jemand abricht
    Exit Do
            End If
                For intZähler = 1 To Len(strDatNam)
                    Select Case Asc(Mid(strDatNam, intZähler, 1))
                        '\ / : * " < > |
                        'und alle Zeichen mit einem Ascii-Code kleiner als 32.
                        Case Is < 32, 92, 47, 58, 42, 63, 34, 60, 62, 124
                            bolsave = False
                        Case Else
                            If bolsave = False Then
                                bolsave = False
                            Else
                                bolsave = True
                            End If
                    End Select
                Next
                If bolsave = True Then
                    ThisWorkbook.SaveAs Filename:=strDatNam
        Exit Do
                Else
                    MsgBox "Unerlaubte Zeichen im Dateinamen, bitte nochmal von vorne !"
                End If
            End If
    Loop
End Sub

MfG Peter

Servus,
tausch den Code mit unterem aus.
Hoffe das er diesmal das Wohl der "alten" findet.

Option Explicit
Private Sub Workbook_Open()
Dim strDatNam As String, strpath As String
Dim intZähler As Integer
Dim bolsave As Boolean
Dim vbmAntwort As VbMsgBoxResult
Dim vrSelectItem As Variant
                        bolsave = True
If ThisWorkbook.Name <> "leer.xls" Then Exit Sub
    vbmAntwort = MsgBox("Wollen Sie die Datei in einem anderen Pfad speichern, als unter C:\Windows ?", vbYesNoCancel)
    If vbmAntwort = vbYes Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            If .Show = -1 Then
                For Each vrSelectItem In .SelectedItems
                    strpath = vrSelectItem & "\"
                    MsgBox strpath
                Next
            End If
        End With
    Else
    strpath = "C:\Windows\"
    End If

    Do
        strDatNam = Application.InputBox("Bitte geben Sie einen Dateinamen an", "Dateinamen")
            If strDatNam = "" Then
                MsgBox "Ein Fehler wurde verursacht !" & Chr(10) _
                       & "Sie haben keinen Dateinamen angegeben !" & Chr(10) _
                        & "Vorgang wird wiederholt !!!"
            Else
            If strDatNam = "Falsch" Then
            'Hier musst du entscheiden was geschehen soll, wenn jemand abricht
    Exit Do
            End If
                For intZähler = 1 To Len(strDatNam)
                    Select Case Asc(Mid(strDatNam, intZähler, 1))
                        '\ / : * " < > |
                        'und alle Zeichen mit einem Ascii-Code kleiner als 32.
                        Case Is < 32, 92, 47, 58, 42, 63, 34, 60, 62, 124
                            bolsave = False
                        Case Else
                            If bolsave = False Then
                                bolsave = False
                            Else
                                bolsave = True
                            End If
                    End Select
                Next
                If bolsave = True Then
                    ThisWorkbook.SaveAs Filename:=strpath & strDatNam
        Exit Do
                Else
                    MsgBox "Unerlaubte Zeichen im Dateinamen, bitte nochmal von vorne !"
                End If
            End If
    Loop
End Sub

MfG Peter

Beliebteste Forumthreads (12 Monate)

beim Start - speichern unter

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

beim Start - speichern unter

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

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread