Speichern als per UserForm / Letztes Blatt nicht drucken

[BuschB]

Hallo Leute,

Ich hab hier ein kleines bisschen VBA Code angefangen bei dem Versuch per UserForm ein Workbook in 2 verschiedenen Versionen zu speichern, als "fertig" und als "work in progress" was momentan folgendermaßen aussieht:

Code:

Private Sub cancel_Click()

  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"

End Sub

Private Sub finished_Click()
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("DC12").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & "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 & ".xlsx"
MsgBox "Die Datei wurde unter " & lw_pfad & "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 & ".xlsx gespeichert.", , "OK"
End If

End Sub

Private Sub name_Change()

Dim name As String
name = "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

End Sub

Private Sub path_Change()

Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("DC12").Value

End Sub

Private Sub work_in_progress_Click()
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("DC12").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & name & ".xlsm"
MsgBox "Die Datei wurde unter " & lw_pfad & name & ".xlsm gespeichert.", , "OK"
End If

End Sub

Ich habe jetzt nur noch eine Hand voll Probleme zu denen ich noch keine befriedigende Lösung gefunden habe:
1. Wie lösche ich vor dem Speichern als "fertig" das Blatt "Vorl. Blatt+"?
2. Wie bekomme ich den vor eingestellten Namen und Pfad in den jeweiligen Textfeldern der UserForm angezeigt und wie übernehme ich Änderungen von den Textfeldern in die Variablen "lw_pfad" bzw. "name"?
3. Wie erzwinge ich das speichern unter via meiner UserForm beim Speichern, Speichern unter, Drucken und Senden per E-Mail?
4. Wie sorge ich dafür das sowohl beim Drucken als auch beim Senden per E-Mail das Blatt "Vorl. Blatt+" nicht mit gedruckt/gesendet wird?

Vielen Dank schonmal^^

[Klaus-Dieter]

Hallo,

zu 1. Blätter per Makro löschen halte ich für eine gefährliche Sache. Da sind dann mal schnell Daten weg, die man noch gebraucht hätte.

[BuschB]

ist richtig, aber in dem Fall handelt es sich um eine Vorlage die nur verwendet wird wenn eine weitere Seite gebraucht wird, im Falle des Speichern als "fertig" sollte das allerdings nicht mehr auftreten weshalb das Blatt "Vorl. Blatt+" nicht mehr gebraucht wird. Habe mir allerdings mit Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden eine ebenfalls funktionierende Alternative geschaffen... denke ich zumindest.

Dafür habe ich gerade ein anderes Problem, sobald ich aus der UserForm "save_as" per "send_mail" raus gehe, beschwert er sich über die Line:

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
    save_as.Show

End Sub

Das er das Formular nicht erneut öffnen kann da es schon geöffnet ist.
Die Frage an der Stelle ist, wie verhindere ich den Versuch das save_as erneut zu öffnen wenn es noch offen ist?


PS:
Noch etwas anderes in Punkto QoL:
kann ich in einem Textfeld einer Userform (in diesem Fall "lw_pfad") auch die Möglichkeit einbauen wie beim Speichern unter den Explorer nach Ordnern etc. zu durchsuchen?

Vielen Dank schonmal^^

[snb]

Dieses ist kein Hellseherforum.

[BuschB]

Ok zu erstens hab ich eine Lösung gefunden, war sogar einfacher als erwartet...

Code:

    With save_as
        If .Visible = False Then
            .Show
        End If
    End With

dafür hab ich jetzt ein anderes Problem abbekommen:

Code:

    Else
        Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
        If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
        Sheets("Blatt 1").Unprotect
        Sheets("Blatt 1").Range("DC12").Value = lw_pfad
        Sheets("Blatt 1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
        Rem MsgBox lw_pfad
        ActiveWorkbook.SaveAs lw_pfad & sp_name & ".xlsm"
        MsgBox "Die Datei wurde unter " & lw_pfad & sp_name & ".xlsm gespeichert.", , "OK"
        With send_mail
            If .Visible = False Then
                .Show
            End If
        End With
        Unload Me
    End If

gibt mir bei: ActiveWorkbook.SaveAs lw_pfad & sp_name & ".xlsm"
einen Fehler aus "Zugriff auf ... Verweigert"
hat da jemand eine Idee woran das liegen könnte?

Danke^^

[snb]

hat da jemand eine Idee woran das liegen könnte?

Du hast keine Beispieldatei hochgeladen.

[BuschB]

Ist mir auch aufgefallen...

Merkwürdigerweise ist das Problem seit einer Weile auch nicht mehr aufgetreten, scheint also nur einmalig gewesen zu sein...
Wie auch immer, mal was ganz anderes, immer wenn Excel mir Outlook öffnet und ich dann im VBA Code etwas ändern will (nachdem ich die Msg Box und Userform geschlossen habe) hängt sich Excel auf ("keine Rückmeldung" laut Task-Manager) liegt das eher an Excel, meinem Code, Outlook oder dem minimalistischen Rechner den ich hier stehen habe?

Code:

Private Sub cancel_Click()
    With save_as
        If .Visible = False Then
            .Show
        End If
    End With
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
    Unload Me
   
End Sub

Private Sub send_Click()
    Sheets("Vorl. Blatt+").Visible = xlSheetVeryHidden
Dim strZiel As String
    strZiel = ziel.Value
Dim strCC As String
    strCC = cc.Value
Dim strBetreff As String
    strBetreff = betreff.Value
Dim strNachricht As String
    strNachricht = nachricht.Value
If AktuelleArbeitsmappeSenden(strZiel, strBetreff, strCC, strNachricht) = True Then
    MsgBox "Erstellung der E-Mail erfolgreich"
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
Else
    MsgBox "Erstellung der E-Mail fehlgeschlagen!"
    Sheets("Vorl. Blatt+").Visible = xlSheetVisible
End If
   
End Sub

Private Sub UserForm_Initialize()
Dim sp_name As String
    sp_name = "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

    ziel.Value = ""
    cc.Value = ""
    betreff.Value = sp_name
    nachricht.Value = ""
   
End Sub

Function AktuelleArbeitsmappeSenden(strZiel As String, strBetreff As String, Optional strCC As String, Optional strNachricht As String) 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 = strZiel
        .cc = strCC
        .Subject = strBetreff
        .Body = strNachricht
        .Attachments.Add ActiveWorkbook.FullName 'mit oder ohne Makro an NLS?
        '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

PS:
Irgendwann erstelle ich auch mal noch eine Beispieldatei, aber momentan bin ich etwas eingebunden, daher erstmal nur der Code

Danke^^

[juvee]

Hi,

aus deinem geposteten Code schließe ich, dass du noch im Beginnerstadium bist.
Daher solltest du dir besonders viel Mühe geben, einen "Plan" zu entwickeln, bevor du anfängst, Code zu schreiben.

Du hast redundanten Code gepostet bei  "finished" und "in progress". Der einzige Unterschied, den ich gesehen habe, besteht beim Pfad/Dateinamen.

Das macht man zwechmäßigerweise in einem "ausgelagerten" Code, dem man die zu speichernde Datei, Pfad und Dateinamen übergibt, z.B. so

Code:

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

End Function

Sub test()
MsgBox speicherDatei(ThisWorkbook, Application.DefaultFilePath & "\", "Test.xlsm")
End Sub

Dieser Code ist aber noch weiter auszubauen, denn es könnte der Pfad nicht existieren, der Dateiname unzulässige Zeichen enthalten, die Datei bereits im Ordner vorhanden sein ( überschreiben ja oder nein ) etc....

Bedeutet: Bist du dir darüber im Klaren, was du beim Speichern alles zu beachten hast und damit in den Code einfließen sollte/muss?

Du bastelst dir in mehreren Codes den Dateinamen aus mehreren ZellInhalten 2x zusammen --> wieder redundant. Erstelle den Dateinamen 1x und speichere diesen z.B. in einer modulweit gültigen Variable. Dann kannst du aus jedem deiner Sub's /Funktionen darauf zugreifen und der Code wird übersichtlicher.

Um ein nicht gewolltest Tabellenblatt zu löschen, müssen 2 Bedingungen erfüllt sein:
die Tabelle muss existieren!
nach dem Löschen muss mindestens noch 1 Tabelle im Workbook vorhanden sein!

Code:

Function wksExists(ByVal sName As String) As Long
On Error Resume Next
wksExists = Not Worksheets(sName) Is Nothing
End Function

Sub TabelleVorhanden()
  If Not wksExists("Tabelle4") Then MsgBox "Worksheet existiert nicht"
End Sub

Ob eine Datei bereits gespeichert ist/war kannst du aus der SAVED-Eigenschaft des WorkbookObjektes erfahren
Und ob eine Datei geöffnet ist, prüft mann wie das Vorhandensein einer Tabelle (s.o.)

verzettel dich nicht sondern löse erst die "einfachen" Aufgaben

VG Juvee

[schauan]

Hallöchen,

ein solcher Fehler tritt z.B. dann auf, wenn Berechtigungen fehlen oder Excel der Meinung ist, dass die Datei offen ist. Letzteres kann z.B. in Firmennetzen auch mal vorkommen, obwohl man sicher sein kann, dass kein anderer Mitarbeiter die Datei offen hat.
Wenn man das erst beim Speichern feststellt, war eventuell einiges an Arbeit für die Katz. Man könnte das z.B. auch so oder ähnlich vorab prüfen, wobei man ggf. das Schließen in der Funktion weglassen kann, ansonsten macht man die Datei zur Verarbeitung nochmal auf ...

Code:

Sub DateiTest()
If IsFileOpen("C:\test\Test.xlsx") Then MsgBox "Bitte 'Test.xlsx' schließen!"
End Sub

Public Function IsFileOpen(ByRef strPath As String) As Boolean
Dim iFile%, lErr&
'Bei Fehler weiter
On Error Resume Next
'Dateinummer festlegen
iFile = FreeFile
'Datei oeffnen, ggf. Fehler an Variable uebergeben und Datei schliessen
Open strPath For Input Lock Write As #iFile: lErr = Err.Number: Close #iFile
Fehlerbehandlung aufheben
On Error GoTo 0
'Fehler verarbeiten
Select Case lErr
  Case 0    'kein Fehler - Zeile kann man auch weglassen
  Case 70: IsFileOpen = True  'Zugriff verweigert
  Case Else: Err.Raise lErr 'sonstiger Fehler
'Ende Fehler verarbeiten
End Select
End Function

[BuschB]

Oh danke euch, und ja, in gewisser Weise bin ich noch etwas Anfänger, hatte zuvor nur mit relativ kleinen Codes zu tun ohne Funktionen die an mehreren Stellen verwendet werden, daher vielen Dank für den Tip, ich werd gleich mal versuchen ob ich das mit dem Auslagern hin bekomme und wie ich dabei trotzdem die kleinen Unterschiede beibehalten kann^^

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

Werde dann auch meinen überarbeiteten Code posten und bei Gelegenheit eine Beispieldatei erstellen.

Danke danke^^