Clever-Excel-Forum

Seiten: 1 2 3 4 5 6 7 8

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^^

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.

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^^

Dieses ist kein Hellseherforum.

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^^

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

Du hast keine Beispieldatei hochgeladen.

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^^

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

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

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^^

Seiten: 1 2 3 4 5 6 7 8

BuschB

Klaus-Dieter

BuschB

snb

BuschB

snb

BuschB

juvee

schauan

BuschB