Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
Ich habe hier ein kleines Problem mit meinem Code:
Code:
Code: If speicherDatei(ActiveWorkbook, strDateiname) = True Then
gibt wohl immer False zurück aber ich weiß nicht warum, was gib in dieser Funktion:
Code:
Code: Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Long
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("*" & wbkname & "*")
If checkname <> "" Then
If checkname <> save_name.Value Then
datei_exist.Show
If Sheets("Blatt 1").Range("DB12").Value = "1" Then
Unload Me
Exit Function
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
Rem MsgBox save_path.Value
End With
.SaveAs save_path.Value & strDateiname
End With
MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If
End Function
False zurück? (muss dazu auch erwähnen das es schonmal funktioniert hatte, bevor ich die Variablen reduziert hab, das Speichern selbst funktioniert auch weiterhin, es kommt halt nur an irgendeiner Stelle ein False)
Und Frage zwei lautet:
Warum bleibt checkname immer leer, scannt Dir nicht in Netzwerklaufwerken des lokalen Firmen Netzwerks? (das checkname und die Dir Funktion sind auch eher nebensächlich, kann das auch weglassen da wir zum Glück nicht so viel haben das wir da nicht auch mal selbst schauen können)
Hoffe ihr hab dafür Ideen und Lösungen?
Registriert seit: 24.08.2022
Version(en): 365, 2019
25.08.2022, 11:05
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2022, 11:12 von EarlFred.)
Was sind denn
- save_name
- save_path
- wbkname
- checkname
- datei_exist?
Ich finde nirgends eine Deklaration und Wertzuweisung. Könnte das relevant sein?
Wenn die Function True oder False zurückgeben soll, sollte sie als BOOLEAN deklariert sein, nicht als Long.
Und irgendwo, wo du den Erfolg des Speicherns festgestellt hast (also nach .SaveAs save_path.Value & strDateiname), müsste dann speicherDatei = True stehen..
(25.08.2022, 08:36)BuschB schrieb: Warum bleibt checkname immer leer, scannt Dir nicht in Netzwerklaufwerken des lokalen Firmen Netzwerks? Dafür müsste man sehen, wo und welchen Wert wbkname bekommt.
Hat Dir mein Beitrag geholfen? Dann hilf auch Du - mit einer Spende an Wikipedia, die Tafeln oder aktion-deutschland-hilft.de
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
Ok, dann hier mal der gesamte Code...
UserForm save_as:
Code: Private Sub cancel_Click()
MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
Sheets("Vorl. Blatt+").Visible = xlSheetVisible
Unload Me
End Sub
Private Sub finished_Click()
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
strDateiname = save_name.Value & ".xlsx"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Kill (save_path.Value & save_name.Value & ".xlsm")
Unload Me
End If
End Sub
Private Sub send_Click()
strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
strDateiname = save_name.Value & ".xlsx"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
With send_mail
If .Visible = False Then
.Show
End If
End With
Unload Me
End If
End If
End Sub
Private Sub UserForm_Initialize()
wbkname = ActiveSheet.Range("C12").Value & ActiveSheet.Range("I12").Value & ActiveSheet.Range("O12").Value & ActiveSheet.Range("U12").Value & ActiveSheet.Range("AA12").Value & ActiveSheet.Range("AG12").Value & ActiveSheet.Range("AM12").Value & ActiveSheet.Range("AS12").Value & ActiveSheet.Range("AY12").Value & ActiveSheet.Range("BE12").Value
save_path.Value = Sheets("Blatt 1").Range("DC12").Value
If Sheets("Blatt 1").Range("DD12").Value <> "" Then
save_name.Value = Sheets("Blatt 1").Range("DD12").Value
Else
save_name.Value = "Schaltprogramm " & wbkname & Sheets("Blatt 1").Range("AF20").Value & Sheets("Blatt 1").Range("AF22").Value
End If
End Sub
Private Sub work_in_progress_Click()
strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Unload Me
End If
End Sub
Function speicherDatei(ByVal wkb As Workbook, ByVal strDateiname As String) As Long
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
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
MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If
End Function
UserForm send_mail:
Code: Private Sub cancel_Click()
With save_as
If .Visible = False Then
.Show
End If
End With
Unload Me
End Sub
Private Sub send_Click()
If AktuelleArbeitsmappeSenden() = True Then
MsgBox "Erstellung der E-Mail erfolgreich"
Else
MsgBox "Erstellung der E-Mail fehlgeschlagen!"
End If
'Kill (lw_path & wbkname & ".xlsx")
End Sub
Private Sub UserForm_Initialize()
ziel.Value = ""
cc.Value = ""
betreff.Value = save_as.save_name.Value
nachricht.Value = ""
End Sub
Function AktuelleArbeitsmappeSenden() As Boolean
On Error Resume Next
Dim appOutlook As Object
Dim meinElement As Object
'Eine neue Instanz von Outlook erzeugen
Set appOutlook = CreateObject("Outlook.Application")
Set meinElement = appOutlook.CreateItem(0)
With meinElement
.To = ziel.Value
.cc = cc.Value
.Subject = betreff.Value
.Body = nachricht.Value
.Attachments.Add save_as.save_path.Value & save_as.save_name.Value & ".xlsx"
'Verwenden Sie send, um sofort zu senden oder display, um auf dem Bildschirm anzuzeigen
.Display 'oder .Send
End With
'Objekte aufräumen
Set meinElement = Nothing
Set appOutlook = Nothing
End Function
Und die genutzten Variablen im eigenen Modul:
Code: Public wbkname As String
Public strDateiname As String
Das ganze getriggert durch:
Code: Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
With save_as
If .Visible = False Then
.Show
End If
End With
End Sub
Private Sub Workbook_BeforePrint(cancel As Boolean)
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
End Sub
in der Arbeitsmappe...
Hoffe jetzt kannst du leichter erkennen was ich meine... Das mit Boolean anstelle von Long kann ich mal ausprobieren, habe den Code für die Funktion aber im groben so gefunden und nur an meine Zwecke angepasst...hatte zuvor auch mal funktioniert trotz Long, aber ich probiere es mal aus und gebe dann nochmal Rückmeldung^^
Registriert seit: 24.08.2022
Version(en): 365, 2019
25.08.2022, 11:55
(Dieser Beitrag wurde zuletzt bearbeitet: 25.08.2022, 11:56 von EarlFred.)
(25.08.2022, 11:17)BuschB schrieb: hatte zuvor auch mal funktioniert trotz Long, aber ich probiere es mal aus und gebe dann nochmal Rückmeldung^^ Ja, auch Long kann das Ergebnis einer boolschen Operation aufnehmen, hat dann aber nicht den Wert True oder False sondern -1 oder 0. Dennoch: Erwartest du einen boolschen Ausdruck, verwende eine boolsche Variable.
Den anderen Tipp probierst du bitte auch erstmal aus, bevor ich mich durch deinen restlichen Code wurschtele:
Zitat:Und irgendwo, wo du den Erfolg des Speicherns festgestellt hast (also nach .SaveAs save_path.Value & strDateiname), müsste dann speicherDatei = True stehen..
Solange du der Function speicherDatei nicht einen Rückgabewert zuweist, liefert sie den Defaultwert des Variablentyps des Rückgabewerts der Function. Bei Long ist das 0, bei einer boolschen Variable False. Beides wird als Falsch interpretiert (siehe Absatz zuvor)
Hat Dir mein Beitrag geholfen? Dann hilf auch Du - mit einer Spende an Wikipedia, die Tafeln oder aktion-deutschland-hilft.de
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
Ah ok, ich muss das also manuell ausgeben, jetzt verstehe ich das Prinzip, super, dann änder ich das gleich, lass es mal durch laufen und schau was passiert.
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
Alles klar, vielen Dank, jetzt Funktioniert es wunderbar, kann ich also mit den nächsten Schwierigkeiten weiter machen:
Ich hab hier im save_as:
Code: Option Explicit
Private Sub cancel_Click()
MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
Sheets("Vorl. Blatt+").Visible = xlSheetVisible
Unload Me
End Sub
Private Sub finished_Click()
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
strDateiname = save_name.Value & ".xls"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Kill (save_path.Value & save_name.Value & ".xlsm")
Unload Me
End If
End Sub
Private Sub send_Click()
strDateiname = save_name.Value & ".xls"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
With send_mail
If .Visible = False Then
.Show
End If
End With
Unload Me
End If
End If
End Sub
Private Sub UserForm_Initialize()
wbkname = ActiveSheet.Range("C12").Value & ActiveSheet.Range("I12").Value & ActiveSheet.Range("O12").Value & ActiveSheet.Range("U12").Value & ActiveSheet.Range("AA12").Value & ActiveSheet.Range("AG12").Value & ActiveSheet.Range("AM12").Value & ActiveSheet.Range("AS12").Value & ActiveSheet.Range("AY12").Value & ActiveSheet.Range("BE12").Value
save_path.Value = Sheets("Blatt 1").Range("DC12").Value
If Sheets("Blatt 1").Range("DD12").Value <> "" Then
save_name.Value = Sheets("Blatt 1").Range("DD12").Value
Else
save_name.Value = "Schaltprogramm " & wbkname & " " & Sheets("Blatt 1").Range("AF20").Value & " " & Sheets("Blatt 1").Range("AF22").Value
End If
End Sub
Private Sub work_in_progress_Click()
strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
Unload Me
End If
End Sub
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
eine Dir eingebaut die mir in einer anderen UserForm, datei_exist:
Code: Option Explicit
Private Sub datno_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 datverg_Click()
Dim ergebnis
Dim aufruf As String
aufruf = "cmd " & DatName.Value
ergebnis = Shell(aufruf, vbNormalFocus)
MsgBox ergebnis & "zum Vergleich geöffnet."
Next
End Sub
Private Sub datyes_Click()
' Kill (checkname)
Unload Me
End Sub
Private Sub UserForm_Initialize()
DatNr.Value = wbkname
With DatName
.Clear
.ColumnCount = 10
.List = checkname
End With
End Sub
bereits existierende Dateien mit derselben Dokumentennummer im Namen auflisten soll und mir die Optionen zur Verfügung stellen soll:
Die Dateien zu öffnen und zu Vergleichen.
Sowie:
Die Dateien zu löschen und die Speicherfunktion fort zu setzen.
Oder:
Die Daten zu behalten und den gesamten Speichervorgang vollständig ab zu brechen, auch das Speichern welches Initial das save_as triggert:
Code: Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
With save_as
If .Visible = False Then
.Show
End If
End With
End Sub
Private Sub Workbook_BeforePrint(cancel As Boolean)
Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
End Sub
Momentan ist es aber noch nicht dazu in der Lage die Dateien in der ListBox DatName zu zeigen, geschweige denn sie zu öffnen, hat da jemand eine Idee was ich vergessen habe, wo mein Fehler liegt?
Danke schonmal^^
Registriert seit: 24.08.2022
Version(en): 365, 2019
26.08.2022, 09:47
(Dieser Beitrag wurde zuletzt bearbeitet: 26.08.2022, 09:47 von EarlFred.)
Mit deiner Userform hast du doch in deinem anderen Thread schon Hundertschaften an Helfern über unzählige Seiten beschäftigt. Das musst du hier nicht auch weiter ausarten lassen.
Ich erachte die Frage, um die es ging, als beantwortet.
Hat Dir mein Beitrag geholfen? Dann hilf auch Du - mit einer Spende an Wikipedia, die Tafeln oder aktion-deutschland-hilft.de
|