Speichern als per UserForm / Letztes Blatt nicht drucken

[BuschB]

Ja is ja richtig, aber wie soll ich am geschicktesten ein Array von "Suchergebnissen" einer Dir aus einer Userform in die Listbox einer anderen bringen wenn nicht über Public Variables?
ich mein

Code:

Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Boolean
If save_name.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
'    checkname = Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly)
'If checkname <> "" Then
'    If checkname <> save_name.Value & ".xls" Then
'        If checkname <> save_name.Value & ".xlsm" Then
'            datei_exist.Show
'            If Sheets("Blatt 1").Range("DB12").Value = "1" Then
'                Unload Me
'                Exit Function
'            End If
'        End If
'    End If
'End If
With wkb
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").ClearContents
        .Range("DC12").Value = save_path.Value
        .Range("DD12").Value = save_name.Value
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    .SaveAs save_path.Value & strDateiname
End With
    speicherDatei = True
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

hier drin, in userform 1 (save_as) ist die Dir deren Ergebnisse ich in folgender Userform 2 (datei_exist) aufgelistet haben möchte:

Code:

Private Sub UserForm_Initialize()
    DatNr.Value = wbkname
With DatName
    .List = checkname
End With

End Sub

Darum die Variable, aber wenn du sagst das es auch mit 

Code:

application.getcustomlistcontents(2)

funktioniert, einverstanden, nur wo kreiere ich diese customlist?

[BuschB]

ok, das hab ich rausbekommen, aber irgendwie listet er mir alles auf (um genau zu sein Wochentage) aber nicht was ich will... wenn ich über:

Code:

Else
If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> "" Then
    If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> save_name.Value & ".xls" Then
        If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> save_name.Value & ".xlsm" Then
            Application.AddCustomList (Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly))
            datei_exist.Show
            If Sheets("Blatt 1").Range("DB12").Value = "1" Then
                Unload Me
                Exit Function
            End If
        End If
    End If
End If

diese CustomList erstelle, welche Nummer hat die dann bzw wie kann ich der eine Nummer zuweisen die noch Verfügbar ist und die ich dann anstelle der 2 in:

Code:

Private Sub UserForm_Initialize()
    DatNr.Value = wbkname
    DatName.List = Application.GetCustomListContents(2)

End Sub

verwenden kann?

[BuschB]

Ok, da ich, wie immer, gesucht habe, habe ich etwas gefunden was laut der Microsoft Excel Hilfe Seite bla bla theoretisch funktionieren müsste:

Code:

Private Sub UserForm_Initialize()
Dim n As Long
    n = Application.GetCustomListNum(Dir(save_as.save_path.Value & "*" & wbkname & "*", vbReadOnly))
    DatNr.Value = wbkname
    DatName.List = Application.GetCustomListContents(n)

End Sub

so sollte ich über "n" die Nummer bekommen, aaaaber:
Fehler: Die Methode 'GetCustomListNum' für das Objekt '_Application' ist fehlgeschlagen (Laufzeitfehler 1004) was nur an einer stelle (bei GetCustomListContent auf der Hilfeseite) erwähnt wird und wohl auftritt wenn die entsprechende Liste bereits existiert (was ja auch Sinn macht wenn ich sie lesen will aber kein Fehler sein sollte) 
Vermutlich ist die Beschreibung des Fehlers inkorrekt , wie dem auch sei, ich finde weder den Grund für den Fehler noch eine Lösung, überall seh ich nur denselben Vorschlag es genau so zu machen...
Hat da jemand eine Idee wo der Fehler liegen könnte und wie ich ihn löse?

[26865]

Was hindert dich daran, ein triviales Datenfeld / Array zu nutzen, wie es André@schauan in Beitrag 38 vorgeschlagen hat?

[BuschB]

Wenn ich anstelle von "Eintrag" bzw anstelle von "myArray" auch 

Code:

Dir(save_as.save_path.Value & "*" & wbkname & "*", vbReadOnly)

da hinschreiben kann, vermutlich nichts...
Leider kommt ein Fehler wenn ich das versuche:
"Eigenschaft List konnte nicht gesetzt werden. Index des Eigenschaftenfelds ungültig."

[BuschB]

ok, ganz anders gelöst:

Code:

Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Boolean
If save_name.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
If save_path.Value = "" Then
    MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
    Exit Function
Else
If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> "" Then
    If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> save_name.Value & ".xls" Then
        If Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly) <> save_name.Value & ".xlsm" Then
            ListArr = Dir(save_path.Value & "*" & wbkname & "*", vbReadOnly)
            datei_exist.Show
            If Sheets("Blatt 1").Range("DB12").Value = "1" Then
                Unload Me
                Exit Function
            End If
        End If
    End If
End If
With wkb
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    With .Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").ClearContents
        .Range("DC12").Value = save_path.Value
        .Range("DD12").Value = save_name.Value
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    .SaveAs save_path.Value & strDateiname
End With
    speicherDatei = True
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

in Userform save_as ruft im entsprechenden Fall des Findens von Dateien mit Namensteil (wbkname) der zu speichernden Datei die Userform datei_exist auf:

Code:

Option Explicit

Private Sub datcancel_Click()
    With ActiveWorkbook.Sheets("Blatt 1")
        .Unprotect
        .Range("DB12").Value = 1
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    End With
    With save_as
        If .Visible = False Then
            .Show
        End If
    End With
    Unload Me
   
End Sub

Private Sub datignore_Click()
    Unload Me

End Sub

Private Sub datdelete_Click()

End Sub

Private Sub UserForm_Initialize()
    DatNr.Value = wbkname
    While ListArr <> ""
        DatName.AddItem ListArr
        ListArr = Dir
    Wend

End Sub

und die füllt die Liste, jetzt will ich nur noch anpassen, wie ich mit den Daten umgehe.
Der Button datcancel ist klar, abbrechen und schließen (fehlt nur die Funktion das originale Speichern ab zu brechen, welches ganz am Anfang per "BeforeSave" die save_as Userform öffnet).
Der Button datignore ist auch ziemlich einfach, datei_exist wird geschlossen und Speichervorgang fortgesetzt.
Der Button datdelete wiederum soll alle in der Listbox DatName angewählten Dateien löschen, das wird nochmal etwas schwierig, weil ich dafür noch keine Idee habe, denke aber die kommt mit der Lösung für das nächste...
Doppelklick auf einen Dateinamen in der Liste soll die entsprechende Datei (mit dem entsprechenden Programm, könnte ja PDF oder JPEG oder sonst was sein) öffnen.

Hat für die Doppelklick-Funktion und den datdelete Button zufällig jemand eine Idee? 
(suche natürlich nebenher selbst nach Lösungsmöglichkeiten und bastle mir was, aber halt nicht mehr heute, weil wegen Feierabend und so xD)

Danke schonmal^^



(Kleine Spielerei nebenbei: Es wäre auch schön, wenn in der Listbox in einer weiteren Spalte nach den Dateinamen auch Datum und Uhrzeit der letzten Änderung an der jeweiligen Datei angezeigt würde, ist aber nicht notwendig.)

[BuschB]

So, wieder ein paar Bastelstunden später:

Code:

Private Sub DatName_DblClick(ByVal cancel As MSForms.ReturnBoolean)
    ShellExecute 0&, "Open", save_as.save_path.Value & DatName.Text, 0, 0, &H9&
End Sub

war der erste Versuch, der hat mir leider nicht die Datei, aber zumindest den Ordner geöffnet, also:

Code:

Private Sub DatName_DblClick(ByVal cancel As MSForms.ReturnBoolean)
Dim sDatei As String
sDatei = Dir(save_as.save_path.Value & DatName.Text)
If sDatei <> "" Then
    ShellExecute 0&, "Open", save_as.save_path.Value & sDatei, 0, 0, &H9&
End If
   
End Sub

Soweit so gut, er öffnet mir jetzt sogar eine Datei, aber eine völlig andere als die, die ich in meiner ListBox angeklickt habe, aber zumindest eine die sich im selben Ordner befindet... Ich weiß zwar nicht warum er das macht, aber er macht es halt.
Da er durch DatName.Text eigentlich auf den in der ListBox angeklickten Dateinamen (mit Endung) beschränkt sein sollte ist es mir völlig unklar wie es passieren kann das das Ding dann sämtliche Beschränkungen die ich zuvor eingerichtet habe über Bord wirft und einfach öffnet was ihm in den Sinn kommt (statt dem gewünschten). 

Hat da jemand eine Idee was ich hier übersehe?

[Kuwer]

Hallo,

Hat da jemand eine Idee was ich hier übersehe?

finde es heraus:

Code:

Private Sub DatName_DblClick(ByVal cancel As MSForms.ReturnBoolean)
Dim sDatei As String
MsgBox save_as.save_path.Value & DatName.Text
sDatei = Dir(save_as.save_path.Value & DatName.Text)
MsgBox sDatei
'If sDatei <> "" Then
'    ShellExecute 0&, "Open", save_as.save_path.Value & sDatei, 0, 0, &H9&
'End If
End Sub

[BuschB]

Ok, ich hab es jetzt:

Code:

Private Sub DatName_DblClick(ByVal cancel As MSForms.ReturnBoolean)
Dim i As Integer
For i = 0 To DatName.ListCount - 1
    If DatName.Selected(i) Then
        ShellExecute 0&, "Open", save_as.save_path.Value & DatName.List(i), 0, 0, &H9&
    End If
Next
   
End Sub

Jetzt muss ich ihn nur noch überreden auch Unterordner zu Durchsuchen, aber das ist nur nebenbei.
Die übrigen Dinge sind ja auch noch nicht erledigt:
Per datdelete_Click die in der ListBox ausgewählten Dateien löschen. (das bekomm ich jetzt da ich das Doppelklick ding hinbekommen habe sicher auch noch hin)
Und per datcancel_click den gesamten Speichervorgang abbrechen, auch den ursprünglichen Auslöser der BeforeSave getriggert hat. (das wäre erstmal das Wichtigste)

Danke schonmal^^

[Kuwer]

Ja, wenn die ListBox auf Singlemodus eingestellt ist.