Clever-Excel-Forum

Seiten: 1 2 3 4 5 6 7 8

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?

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?

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?

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

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."

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

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?

Hallo,

(01.09.2022, 11:24)BuschB schrieb: [ -> ]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

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^^

Ja, wenn die ListBox auf Singlemodus eingestellt ist.

Seiten: 1 2 3 4 5 6 7 8

BuschB

BuschB

BuschB

26865

BuschB

BuschB

BuschB

Kuwer

BuschB

Kuwer