Automatisches Speichern "WENN" VBA

[bronko87]

Hallo ,

Ich stehe vor einer Aufgabe der ich nicht gewachsen bin, und wollte  ob ihr mir vielleicht dabei helfen könntet. Ich habe eine Mappe erstellt in der man die weißen Felder ausfüllen kann. Zuerst muss die Maschine und die Personalnummer eingegeben werden, danach die Maße. Ein Zeitstempel erscheint wenn die Personalnummer eingegeben wurde. Jetzt kommem meine 2 eigentlichen .

Mein Ziel bzw wunsch wäre es, wenn die Liste komplett ausgefüllt ist dass beim betätigen des Speicher Button folgende Meldung erscheint '' Möchten Sie dieses Dokument speichern? Diese Meldung sollte bestätigt werden. Nach Bestätigung des Speicher Buttons sollte die Arbeitsmappe ohne eingeben Werte wieder dargestellt werden.

Nun das wahrscheinlich komplizierteste an der ganzen Sache!!! Die von mir erstellte Mappe sollte eigentlich wie eine art Vorlage oder Maske dienen. Je nach ausgewählter Maschine (M027 oder M074) sollte die ausgefüllte Mappe in Folgendes  abgespeichert werden.
C:\Dokumente und Einstellungen\AzubiPC\Desktop\M027 oder \M074  je nach Auswahl der Zelle "Maschine" abgespeichert werden. Der Dateiname sollte Automatisch dem Zeitstempel Wert entsprechen. So könnte ich haufenweise Daten sammeln und für mein Jahresprojekt auswerten. Ich würde mich riesig über  freuen


PS: Meine Mappe befindet sich im Anhang.

[StefKe]

Hallo bronko, kompliziert ist das nicht...nur bisschen Arbeit :-).

Je nach ausgewählter Maschine (M027 oder M074) sollte die ausgefüllte Mappe in Folgendes  abgespeichert werden.
C:\Dokumente und Einstellungen\AzubiPC\Desktop\M027 oder \M074  je nach Auswahl der Zelle "Maschine" abgespeichert werden. Der Dateiname sollte Automatisch dem Zeitstempel Wert entsprechen

Speichere diese Arbeitsmappe als Arbeitsmappe mit Makros .xlsm ab. Anschließend zeichnest Du mit laufendem Makrorecorder obige Arbeitsschritte auf.
Wenn das fertig ist stellst Du die Mappe bitte nochmal hier rein. Ein Tabellenblatt sollte weiß sein und das ein zweites Blatt alle Werte enthalten die gespeichert werden müssen.
Dann können wir die Aufzeichnung sortieren und anpassen.

Bei Bedarf findest Du HIER eine Anleitung zur Aufzeichnung mit dem Makrorecorder.

Bis später
Stefan

[bronko87]

Vielen dank StefKE 
Da ich ein Excel Neuling bin, hoffe ich das ich alles soweit richtig gemacht habe.
Mit der Dateibezeichnung beim abspeichern wusste ich nicht wie ich dass mit dem Zeitstempel anstellen soll.
Ich hoffe das es nicht all zu schlimm ist 

[StefKe]

Du hast alles richtig gemacht     Hier der Code:

Code: [Auswählen]

Sub SpeichernUnterUndOeffnen()
Dim strFileName As String
Dim strMaschine As String
'
Application.DisplayAlerts = False
    With Worksheets("Datenblatt")
        strMaschine = .Range("A3")
        strFileName = .Range("E3")
    End With
       
    strFileName = Replace(strFileName, " ", "_")
    strFileName = Replace(strFileName, ":", "_")
   With ActiveWorkbook
        .SaveAs Filename:="C:\Users\IBron\Desktop\" & strMaschine & "\" & _
        strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .Worksheets("Datenblatt").Range("A3:C3").ClearContents
        .SaveAs Filename:="C:\Users\IBron\Desktop\Test_Re.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End With
       
Application.DisplayAlerts = True

End Sub
Die Datei funzt aber nur auf dem Rechner "IBron". Ansonsten muss der Pfad angepasst werden...was kein Problem ist

Grüße...

[bronko87]

WOW vielen vielen dank für deine mühe und 
Ich bin schon die ganze Nacht wach und hab mir über dieses Projekt das ich gerade erarbeite noch ein paar  gemacht.
Ist es es machbar mehrere solcher Vorlagen(Protokolle) zusammenzutragen bzw wie eine Art Menü aufzubauen?
Würde bedeuten das ich ein Hauptmenü Anlege. In dem Menü sind 5 verschiedene Protokolle bzw ausfüllbare Vorlagen aufgelistet.
Je nach bedarf anwählbar ist. Wie im ersten Beispiel von mir genannt wird die Datei anhand der Maschine in den jeweiligen Ordner abgespeichert.
Ebenso sollte wieder die abgespeicherte Datei den Zeitstempel als Namen tragen. Nach dem Speichervorgang sollte man automatisch wieder in das Hauptmenü gelangen.
Nun der Knackpunkt. Ist es möglich das jede neu angefangene Kalenderwoche irgendwie Automatisch ein neuer Zielordner angelegt wird?
Zum Beispiel Ordner"KW05" ist nicht mehr der Zielordner sondern KW06 da diese Kalenderwoche begonnen hat?
Und kann mann vielleicht auch das Blatt farblich anzeigen wegen den bedingten Formatierungen? So wäre es gewährleistet das während dem Messen und des Eintragen des Wertes
das der Arbeiter sieht das dieses Maß in der Toleranz oder Außerhalb liegt.

Ich hoffe ich bin nicht zu aufdringlich oder so wenn ich gleich nochmal etwas zu wollen.
Ich würde gerne dabei helfen die Makros erneut aufzuzeichnen. Müsste nur  was alles benötigt wird.

Vielen dank

[StefKe]

Hi bronko87, das ist kein Problem. Wir machen es Schritt für Schritt.

Code: [Auswählen]

Sub PPQ_SBB_zeigen()
    Worksheets("PPQ SBB").Activate
End Sub
Damit kannst Du die Blätter untereinander verlinken. Diesen Code musst Du für jedes Tabellenblatt anpassen und in das Modul1 eintragen.
Anschließend wird in den Excel-Arbeitsblättern den Button's das entsprechende Makro zugewiesen.
Für das Blatt PPQ_SBB habe ich es Dir vorbereitet. Wenn alles fertig ist stelle die Datei hier wieder ein.

Stefan

[bronko87]

Mahlzeit Stefan 

Du kannst dir nicht vorstellen wie dankbar ich dir bin.

Denke ich werde alles soweit richtig gemacht haben.

Anbei,

 

[StefKe]

Kein Problem, hast alles richtig gemacht. Nächste Aufgabe: alle Buttons "Drucken" aktivieren:

Code: [Auswählen]

Sub Drucken()
     Application.Dialogs(xlDialogPrint).Show
 End Sub

Code: [Auswählen]

Sub Drucken()
     ActiveSheet.PrintOut
 End SubEs stehen diese beiden anpassbaren Druckoptionen zur Verfügung. Also kannst Du das Sub Deiner Wahl im Modul eintragen und dann allen Buttons "Drucken" dieses Makro zuweisen.
PS.: die Verlinkung zurück zum Hauptmenü fehlt noch :-)

[bronko87]

Guten Abend ;-)
Jetzt bekomme ich so langsam mal den Aufbau mit :-)
Echt Super wie du das machst   
Hab es hinbekommen :-)

[StefKe]

Na passt doch, ändere noch das Makro Zurück_in_das_Hauptmenü:
Jetzt:

Code: [Auswählen]

Sub Zurück_in_das_Hauptmenü()
'
' Zurück_in_das_Hauptmenü Makro
'

'
    ActiveSheet.Shapes.Range(Array("Button 3")).Select
    Sheets("Hauptmenü").Select
End Sub
Neu:

Code: [Auswählen]

Sub Zurück_in_das_Hauptmenü()
    Sheets("Hauptmenü").Select
End Subund verschiebe es ins Modul1. Das Modul2 kannst Du mit Rechtsklick im Kontextmenue löschen. Du erkennst das nicht alles Aufgezeichnete sinnvoll ist.
Als nächstes stelle die Druckbereich nach Deinen Vorstellungen ein. Dann beginnen wir mit den Tabellenblättern.

Frage: willst Du wirklich die vollständige Arbeitsmappe in den neuen Ordnern speichern oder vielleicht nur das ausgefüllte Tabellenblatt als *.pdf-Datei?

Und kann mann vielleicht auch das Blatt farblich anzeigen wegen den bedingten Formatierungen? So wäre es gewährleistet das während dem Messen und des Eintragen des Wertes
das der Arbeiter sieht das dieses Maß in der Toleranz oder Außerhalb liegt.

Das Blatt oder die ausgefüllten Zellen?


Stefan

[bronko87]

Guten Morgen,


Bezüglich deiner , ich bin mir nicht 100 pro sicher was am besten wäre.
Hab mir überlegt, da sich nach einer gewissen  sich einige Messwerte der 5 Verschiedenen Tabellen ansammeln wäre es vieleicht besser die eintragennen Messwerte Seperat in eine Liste reinzuschreiben bezüglich wenn ich diese Auswerten möchte. Ist das möglich das ich die ausgefüllten Messergebnisse seperat in eine ganz andere Mappe einfließen zu lassen?
PDF Format wäre da glaube ich nicht so von vorteil.

- Die ausgefüllten Zellen ;-)

[StefKe]

Moin, es ist möglich (lt. Google  ) Werte in eine "geschlossen" Arbeitsmappe zu schreiben und für eine spätere Auswertung auch besser geeignet. Wie willst Du die Arbeitsmappen strukturieren? Soll für jede Maschine eine Arbeitsmappe angelegt werden oder so wie in  2-1.pdf dargestellt ist, für jedes Tabelleblatt?

[bronko87]

Hi :-)
Am besten so wie auf den 2 PDF dateien ;-) Das wäre einfach perfekt!!! ;-)

[StefKe]

o.k., dann lege bitte 5 neue Arbeitsmappen an und bennen sie wie gewünscht. In jeder Mappe sollte ein Tabellenblatt als Muster liegen wie das Archiv später aussehen soll. Das alles liegt gemeinsam mit der Mappe "Programm.." in einem Ordner.
Diesen Ordner mit WinRar packen (o.ä.) und hier einstellen...dann sehen wir weiter.

[bronko87]

Guten Abend Stefan,

Etwas spät dran, aber besser als nie 

[StefKe]

Du hast in 2.pdf einen senkrechten Tabellenaufbau gewählt im Gegensatz zum jetzigen Aufbau. Warum hast Du den Aufbau geändert? So hast Du die Möglichkeit später die Daten als Tabelle zu filtern. Können wir es so belassen?

Hatte noch was vergessen: in der Mappe "Programm..." sollten die Tabellenköpfe gleich aufgebaut sein.
A3 = Maschine
B3 =
C3 = Name
B4 = Zeitstempel
Spalte A = Teile

die ersten 2 Sheets sind so vorbereitet, der Rest ist Deins :-) Dann kann für alles Sheets ein Makro verwendet werden, was die Tipparbeit und Fehlersuche ungemein erleichtert :-)

In den Archiven sollte der fast der gleiche Tabellenaufbau sein.
Spalte A = Zeitstempel
Spalte B = Maschine ( in der ursprünglichen Version sollte für jede Maschine ein separates Blatt angelegt werden?) u.s.w.

Tja,  über Arbeit 

[StefKe]

Code: [Auswählen]

Sub DatenExportieren()
Dim wksQuelle As Worksheet
Dim strMaschine As String
Dim strPersonal As String
Dim datZeit As Date
Dim strBlattname As String
Dim strZielPfad As String
Dim rngDaten As Range
Dim wksZiel As Worksheet

    Set wksQuelle = ThisWorkbook.ActiveSheet
    With wksQuelle
        strMaschine = .Cells(3, 1)
        strPersonal = .Cells(3, 2)
        datZeit = .Cells(4, 2)
        strBlattname = .Name
   
        strBlattname = ActiveSheet.Name
        strBlattname = Replace(strBlattname, " ", "_")
        strZielPfad = "Archiv_" & strBlattname & ".xlsx"
       
        Select Case strBlattname
            Case strBlattname = "PPQ_SBB"
                rngDaten = .Range("B6:G11") 'so sollten die zu übertragenen Bereiche für alle Tabellenblätter definiert werden
            Case strBlattname = "CREED_SBB"
                rngDaten
            Case strBlattname = "Handmaße_PPQ_MY_2015"
                rngDaten
            Case strBlattname = "Handmaße_PPQ_Q5_Match"
                rngDaten
            Case strBlattname = "Einrichthilfe_PPQ_1Bearbeitung"
                rngDaten
            Case Else
        End Select
    End With
End Sub
 [/font][/size]

rngDaten = .Range("B6:G11") 'so sollten die zu übertragenen Bereiche für alle Tabellenblätter definiert werden

 
 Du musst den rngDaten für alle weiteren Tabellenblätter definieren(je nachdem wie die Bereiche liegen) und den Code am Ende von Modul1 eintragen. Die rngDaten werden im weiteren Code kopiert und in das zugehörige Archiv eingetragen.[/font]

Wenn Du damit fertig bist gehts weiter  [/font]
 
 

[bronko87]

Hallo Stefan,
Bezüglich der Programm Mappe, wäre as auch okay das ich den Zeitstempel auf E3 setzt stat auf B4?

[StefKe]

Klar, das passt. Aber versuche das der Zeitstempel bei allen anderen Tabellenblättern auch auf E3 liegt...ist's möglich?

[bronko87]

Alles klar, versuche das alles bis Sonntag Abend zu machen 
Danke Stefan, schönes WE!!! 

[bronko87]

Hallo Stefan,

Wollte dir kurz nochmal das aktuelle schicken.
Ist das soweit okay so?
Hab aber das letzte Aufgabe bzg. der rng.Dateb  noch nicht.

gruß markus

[StefKe]

Danke, hast alles richtig gemacht. Ich habe aber noch ein paar Veränderungen in allen Mappen gemacht. Bitte schau es Dir an und gib o.k., oder nicht. Dann arbeiten wir mit Deinem Ordner weiter.
PS. wenn Du noch was änderst dann bennene bitte dein Ordner fortlaufen um, z.Bsp. Ordner_3. und  lade ihn wieder hoch.

Stefan

[bronko87]

Sieht gut aus ;-)

[StefKe]

Ja schön, das beantwortet aber noch nicht die Fragen vom Blatt: PPQ SBB und Handmaße PPQ MY 2015 ...das interessiert mich schon 

[bronko87]

 ;Dbezüglich PPQ und Creed, damit lässt es sich gut arbeiten.

Die Zellen müssen nicht verbunden sein ;-)

Die grau hinterlegten Zellen sind bedingt formantiert. Die weißen sind per Datüberprüfung/Liste hinterlegt mit i.o oder n.iO.
Vor dem Speichern sind alle ausgefüllt. (Folgende Daten sollten übertragen werden. (D5:I38)

gruß Markus

[StefKe]

Code: [Auswählen]

Sub DatenExportieren()
Dim wksQuelle As Worksheet
Dim strMaschine As String
Dim strPersonal As String
Dim datZeit As Date
Dim strBlattname As String
Dim strZielPfad As String
Dim rngDaten As Range
Dim wksZiel As Worksheet

    Set wksQuelle = ThisWorkbook.ActiveSheet
    With wksQuelle
        strMaschine = .Cells(3, 1)
        strPersonal = .Cells(3, 2)
        datZeit = .Cells(4, 2)
        strBlattname = .Name
   
        strBlattname = ActiveSheet.Name
        strBlattname = Replace(strBlattname, " ", "_")
        strZielPfad = "Archiv_" & strBlattname & ".xlsx"
       
        Select Case strBlattname
            Case strBlattname = "PPQ_SBB"
                rngDaten = .Range("B6:G11") 'so sollten die zu übertragenen Bereiche für alle Tabellenblätter definiert werden,
            Case strBlattname = "CREED_SBB"
                rngDaten 'hier den zu kopierenden Bereich vom Tabellenblatt "B6:G11" eintragen
            Case strBlattname = "Handmaße_PPQ_MY_2015"
                rngDaten 'hier den zu kopierenden Bereich vom Tabellenblatt "Handmaße_PPQ_MY_2015" eintragen
            Case strBlattname = "Handmaße_PPQ_Q5_Match"
                rngDaten 'hier den zu kopierenden Bereich vom Tabellenblatt "Handmaße_PPQ_Q5_Match" eintragen
            Case strBlattname = "Einrichthilfe_PPQ_1Bearbeitung"
                rngDaten 'hier den zu kopierenden Bereich vom Tabellenblatt "Einrichthilfe_PPQ_1Bearbeitung" eintragen
            Case Else
                MsgBox "das Tabellenblatt: " & strBlattname & " muss noch angelegt werden"
               
        End Select
    End With
End Sub
perfekt, dann trage obigen Code in das Modul1 ein, passe die Bereiche an und stelle die Mappe hier wieder ein.

[bronko87]

erledigt ;-)

[StefKe]

Hallo Bronko, im Anhang die Datei "Handmaße...". Versuchst Du bitte die Zeilen so zu ändern das "Maschine" in Zeile 2 steht. Die Zeilensprünge wie in Zelle E1 erreichst Du mit Alt+Enter.
Falls das nicht passt müssen alle anderen Archive so geändert werden das "Maschine" in der gleichen Zeile steht.

Danke und bis später

[bronko87]

Hallo Stefan,

Wäre es möglich das wir doch die andere Variante nehmen?
Sprich die ausgefüllte Mappe in den Maschinenbezogenen Ordner. Mit Zeitstempel als Datei Name?

gruß markus

[StefKe]

Verstehe grad nicht wirklich...

Maschinenbezogenen Ordner.

oder maschinenbezogene Arbeitsmappe (Workbook)?

Zeitstempel als Datei Name

oder als Blattname(Worksheet)?
mach mal eine Beispielmappe zurecht. Das Prinzip ist klar, nur die Sortierung noch nicht  .