Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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^^
Registriert seit: 11.04.2014
Version(en): Office 365
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.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter,
der Misserfolg ist ein Waisenkind
Richard Cobden
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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^^
Registriert seit: 29.09.2015
Version(en): 2030,5
Dieses ist kein Hellseherforum.
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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^^
Registriert seit: 29.09.2015
Version(en): 2030,5
Zitat:hat da jemand eine Idee woran das liegen könnte?
Du hast keine Beispieldatei hochgeladen.
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
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^^
Registriert seit: 21.08.2022
Version(en): 2016
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
Folgende(r) 1 Nutzer sagt Danke an juvee für diesen Beitrag:1 Nutzer sagt Danke an juvee für diesen Beitrag 28
• Primo Centurio
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
22.08.2022, 16:28
(Dieser Beitrag wurde zuletzt bearbeitet: 22.08.2022, 16:29 von 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
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 19.08.2022
Version(en): 16.0.15427.20210
23.08.2022, 06:16
(Dieser Beitrag wurde zuletzt bearbeitet: 23.08.2022, 06:19 von 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^^
|