Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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?
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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?
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
30.08.2022, 10:50
(Dieser Beitrag wurde zuletzt bearbeitet: 30.08.2022, 10:56 von 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
Nicht registrierter Gast
Was hindert dich daran, ein triviales Datenfeld / Array zu nutzen, wie es André@schauan in Beitrag 38 vorgeschlagen hat?
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
30.08.2022, 14:38
(Dieser Beitrag wurde zuletzt bearbeitet: 30.08.2022, 14:47 von 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."
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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.)
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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?
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
01.09.2022, 13:09
(Dieser Beitrag wurde zuletzt bearbeitet: 01.09.2022, 13:39 von 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^^
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
01.09.2022, 13:35
(Dieser Beitrag wurde zuletzt bearbeitet: 01.09.2022, 13:44 von Kuwer.)
Ja, wenn die ListBox auf Singlemodus eingestellt ist.
|