Speichern als per UserForm / Letztes Blatt nicht drucken

[BuschB]

Also es kommt keine Fehlermeldung und auf den ersten Blick funktioniert gar nichts. Einzelschritte habe ich aus Zeitgründen noch nicht versucht, mache ich aber gleich morgen früh. Falls bis dahin schon jemand eine Idee hat super, falls nicht geb ich auf jeden Fall nochmal Rückmeldung nach dem Test mit Einzelschritten.

[juvee]

Nur eine Frage, was hat die 52 in deinem Code fürs Speichern zu sagen?

Hi,

schau mal in der Hilfe bei saveas nach, dort findest du die Parameter, die du übergeben kannst.
XlFileFormat-Enumeration  52 entspricht  ...xlsm,  51 speichert die Datei als ...xlsx


so, und nun nochmal zur Erklärung der Funktion speicherDatei()

Code:

Function speicherDatei(ByVal wkb As Workbook, ByVal strPfad As String, ByVal strDateiname As String, Optional fFormat As Integer = 52) As Long
On Error Resume Next
wkb.SaveAs strPfad & strDateiname, fFormat
speicherDatei = Err.Number = 0
End Function

Sub test()
    MsgBox speicherDatei(ActiveWorkbook, Application.DefaultFilePath & "\", "Speichertest", 51)
End Sub

ich hatte ja bereits auf mögliche Unwägbarkeiten beim Speichern hingewiesen.

Teste doch einfach mal den obigen Code in einer Datei aus.
Wenn du das Makro Test ausführst, wie es dort gepostet ist, ( mit fileformat 51), dann speichert die Funktion die Beispieldatei als  Speichertest.xlsx in deinem normalem Speicherpfad und du bekommst als Ergebnis in der MsgBox -1 angezeigt. Das ist der Wert für TRUE, die Aktion war erfolgreich.
Rufst du das Makro so erneut auf, bekommst du zunächst die Windows-Meldung, dass die Datei bereits existiert, und je nach dem, was du geklickt hast ( trotzdem speichern und die vorhandene Datei überschreiben, nicht speichern, abbrechen ) wird entsprechend agiert und Funktion liefert dir 0  ( entspricht FALSE ) zurück, was bedeutet, dass die automatische Speicherung nicht geklappt hätte.
Führst du den Test nun ein 3. Mal durch und läßt ", 51" weg, speichert die Funktion deine Datei als Speichertest.xlsm in deinem normalen Speicherpfad.

So, nun kannst du nochmal überlegen, ob und wie du auf mögliche "Speicherfehler" reagieren willst.

Ich empfehle nochmal, einen Ablaufplan zu erstellen ( kann man auch Struktogramm nennen ).
Da du eine .xlsx-Datei per Outlook versenden willst, die anschließend gelöscht werden soll, könntest du in die Funktion speicherDatei() in einer If-Verzweigung implementieren
-die Vorlage-Tabelle  zu löschen
-die Datei zu speichern
-die Datei zu versenden (Übergabe der gespeicherten Datei an eine sendmail-funktion, die dir den Erfolg zurückliefert)
während der else-Teil lediglich die Datei als xlsm speichert.

Die xlsx-Datei löscht du erst dann, wenn du die Rückmeldung der erfolgreichen Versendung erhalten hast.

Der Phantasie sind keine Grenzen gesetzt.

VG Juvee

[BuschB]

Ah ok, verstehe, das vereinfacht den Teil, allerdings hab ich mir die Speicherfunktion jetzt für beides, die ".xlsx" und die ".xlsm" Version gebastelt und die jeweilige Endung in die strDareiname integriert, keine Ahnung ob das auch mit der 51 und 52 geht, werd ich aber mal ausprobieren, was das Speichern selbst angeht ist mein Plan das bei bereits existierende Dateien mit dem Namen wie bisher einfach nachgefragt werden soll, ob sie überschrieben werden dürfen, ich tendiere auch dazu, eine weitere Userform für den Fall zu entwickeln, die mir da drei Optionen liefert, "Ja", "Nein" und "Datei öffnen zum Vergleichen" mit dem Ziel den Anwender selbst die bereits existierende Datei an zu schauen und zu sehen, ob es nur eine ältere Version der selbst geschriebenen oder eine völlig andere Datei ist und er seine Nummer/seinen Dateinamen ändern muss. Aber eins nach dem anderen, erstmal muss das allgemeine funktionieren bevor ich Details einbaue, daher erstmal der Einzelschritttest, dazu Folgendes:

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
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 Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    Sheets("Blatt 1").Unprotect
    Sheets("Blatt 1").Range("DC12").Value = save_path.Value
    Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    Rem MsgBox save_path.Value
    wkb.SaveAs save_path.Value & strDateiname ', 52
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

Er springt in der Funktion von "If save_name.Value = "" Then" direkt zum letzten "End If" üerspringt somit die gesamte Aktion des Speicherns, schließt diese somit gar nicht ab und führt entsprechend der False-Meldung weiter oben:

Code:

Private Sub work_in_progress_Click()
Dim strDateiname As String
    strDateiname = save_name.Value & ".xlsm"
If speicherDatei(ActiveWorkbook, strDateiname) = True Then
    Unload Me
End If

End Sub

Das nächste "End If" aus wobei ebenfalls alle dazwischen liegenden Befehle übersprungen werden (was in dem Fall auch richtig ist).
Problem ist, save_name.Value dürfte niemals leer sein wenn der Anwender nicht zuvor das entsprechende Textfeld leer macht, schließlich fülle ich es ja hier:

Code:

Private Sub UserForm_Initialize()
    save_name.Value = "Schaltprogramm " & 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
   
End Sub

wo liegt also der Fehler?

---

...Ich glaub ich seh es grade... Ich probier mal was aus:

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
    If Right(save_path.Value, 1) <> "\" Then save_path.Value = save_path.Value & "\"
    Sheets("Blatt 1").Unprotect
    Sheets("Blatt 1").Range("DC12").Value = save_path.Value
    Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
    Rem MsgBox save_path.Value
    wkb.SaveAs save_path.Value & strDateiname ', 52
    MsgBox "Die Datei wurde unter " & save_path.Value & strDateiname & " gespeichert.", , "OK"
End If
End If

End Function

Jetzt mit dem "Else" komm ich auf jeden Fall weiter, nur noch ein paar andere Kleinigkeiten die ich mir nochmal genauer anschauen muss.
xD

---

Ok soweit so Gut, jetzt tritt anscheinend tatsächlich das Problem auf welches ich mit einer dritten UserForm lösen will, die Speicher Funktion gibt mir False zurück und überspringt dadurch jetzt alles darauf Folgende. Heißt, ich muss jetzt damit anfangen, in der Funktion irgendwo den Part mit der Prüfung ob Datei bereits existiert und wenn dann UserForm 3 bla bla blubb... wird eine kleine Weile dauern, melde mich wieder. 

Danke schonmal für all die Hilfe^^

[BuschB]

So, nu bin ich fleißig am Basteln meiner dritten UserForm, die öffnet sich zwar bisher noch nicht, aber das bekomme ich noch hin, entscheidend ist gerade die Frage, wie ich Excel dazu bringe wenn ich in meiner save_as UserForm auf Abbrechen klicke, das dann jegliches Schließen und Speichern abgebrochen wird... habe dazu auch schon ein wenig Google befragt, aber entweder gab es da Lösungen zum Schließen ohne zu speichern oder welche die automatisch speichern ohne Rückmeldung und solche Sachen, aber nichts was Speichern abbricht und das Workbook offen lässt... 
Hat da jemand eine Idee zu?

Außerdem, kann ich in einem anderen Modul auf das Klicken eines bestimmten Buttons einer bestimmten UserForm reagieren?

[BuschB]

Sooo, das ist der komplette Code der 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
    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

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

UserForm datei_exist (noch unvollständig):

Code:

Private Sub datno_Click()
    With .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()
Option Explicit
    Sub aufrufen()
    Dim ergebnis
    Dim aufruf As String
        aufruf = "cmd " & DatName.Value
        ergebnis = Shell(aufruf, vbNormalFocus)
        MsgBox ergebnis & "zum Vergleich geöffnet."
    Next
End Sub

End Sub

Private Sub datyes_Click()
    'Kill (checkname)
    Unload Me

End Sub

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

und die Public Variables:

Code:

Public wbkname As String
Public strDateiname As String
Public checkname As String

leider hab ich hierbei mehrere Probleme:
Zu 90% funktioniert "Unload Me" nicht (nur bei save_as cancel_Click).
Die "checkname = Dir ("*" & wbkname & "*")" gibt, obwohl ich sogar 3 PDF mit derselben Zeichenkombination im Namen wie "wbkname" besitze, checkname immer als leer aus. (vermute das Dir ohne vorgegebenen Pfad nur Lokal sucht und Netzwerkspeicher etc ignoriert?)

Hoffe für beides gibt es eine Lösung?
Danke schonmal^^

[BuschB]

Ich weiß jetzt warum das Unload Me nur beim abbrechen funktioniert, das ist der einzige Button von save_as, der nicht die Funktion zum Speichern feuert... Die Funktion selbst läuft auch einwandfrei durch, aber im Anschluss, die Abfrage:

Code:

If speicherDatei(ActiveWorkbook, strDateiname) = True Then

gibt wohl immer False zurück da alle nachfolgeden Aktionen übersprungen werden... Frage ist also, was gib in dieser Funktion:

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?

Hoffe ihr hab dafür Ideen und Lösungen?

[snb]

Die beste Lösung scheint mir in diesem Fall ein Grundlagenbuch VBA.

[BuschB]

na wenn du eins hast dann her damit xP

[schauan]

Hallöchen,

scannt Dir nicht in Netzwerklaufwerken des lokalen Firmen Netzwerks

Dir schaut in dem Verzeichnis nach, welches Du ihm mitgibst oder, falls nicht, dann im aktuellen.

gibt wohl immer False zurück

dazu gab's in Deinem anderen Thread eine Antwort ...

Grundlagenbuch VBA

... schau mal auf Amazon, ebay, hood, Thalia, terrashop.de, ...
oder einige Tipps hier Forum-Interessante-Zusatzsoftware-und-Literatur

[BuschB]

Dir schaut in dem Verzeichnis nach, welches Du ihm mitgibst oder, falls nicht, dann im aktuellen.

bezieht sich das aktuelle auf den Speicherort der Datei die man gerade geöffnet hat oder auf den Installationsort von Excel?
(Reine Neugier, werde wohl eh manuell einen Pfad rein werfen müssen wenn es so ist)

Ansonsten vielen Dank für die Hilfe an alle ^^