VBA - Aus Userform andere Mappe öffnen
09.03.2016 02:23:07
Tim
lange Zeit bin ich nun schon leser eurer tollen Tipps. Jetzt ist aber die Zeit gekommen um mal um Rat zu fragen.
Ich habe eine Userform in der unsere Mitarbeiter Daten eingeben. Wenn die Dateneingabe erfolgreich war, werden diese Daten in ein Tabellenblatt eingefügt, als pdf exportiert und an eine eMail-Adresse versendet. Gleichzeitig werden diese Daten zur Zeit in einem zusätzlichen Tabellenblatt (in der selben Mappe) in eine Datenbank geschrieben die später von einer anderen Mappe zur Statistik ausgelesen wird. Der Grund dafür ist, dass auf die Statistik-Mappe nur ein gewisser Personenkreis Zugriff hat.
Soweit funktioniert das ganze auch wunderbar.
Jetzt kommt das Problem:
Die Mappe mit der Userform soll von mehreren Usern zeitgleich nutzbar bleiben. Mir schwebt deshalb vor, dass die Datei in einem Ordner abgelegt wird in dem die User nicht schreibberechtigt sind. Ergo die Mappe immer schreibgeschütz geöffnet wird. Das setzt natürlich voraus das die Wert aus der Userform in eine seperate Mappe (Datenbank) geschrieben werden. Leider stehe ich zur Zeit auf dem Schlauch und hoffe auf eure Hilfe.
Ich müsste die Mappe (Datenbank) öffnen, die Werte in die Datenbank schreiben und mit anschließend wieder schließen (inkl. speichern) und das so das der User das nicht mitbekommt.
Mein Code der Userform sieht so aus (der fette Teil schreibt in das Tabellenblatt):
Option Explicit
'***************************************************************************
'Beim Öffnen der Userform werden die Werte Datum, der Name der in Office
'eingetragen wurde, die User-ID und das Datum in den Kalender eingetragen
'***************************************************************************
Sub UserForm_Initialize()
Label2.Caption = Format(Date, "dddd, dd. mmmm yyyy")
Label4.Caption = Application.UserName
Label6.Caption = Environ("UserName")
DTPicker1.Value = Date
TextBox4.Text = Application.UserName
'ComboBox2 ohne leerzeilen aus Datenbank befüllen
Dim Zelle As Range
ComboBox2.Clear
With Sheets("Objekte")
For Each Zelle In .Range(.Cells(2, 3), .Cells(1000, 3).End(xlUp))
If Zelle.Value "" Then ComboBox2.AddItem Zelle.Value
Next
End With
End Sub '***************************************************************************
'Bei Klick auf Eintragen wird das Makro gestartet.
'Zuerst wird ein Abfrage der Pflichtfelder durchgeführt
'Dann werden die Werte in die Interventionstabelle und anschließend
'in die Datenbank geschrieben. Die Userform wird geschlossen.
'Anschließend werden die Funktionen zum Erstellen der pdf-Datei und
'zum automatischen Versand der aufgerufen.
'***************************************************************************
Private Sub Eintragen()
'Arbeitsblatt Intervention anwählen
Worksheets("Intervention").Visible = True
Worksheets("Intervention").Activate
'OE-Kurzzeichen
If ComboBox1.Value = "" Then
MsgBox "Bitte wähle noch das OE-Kurzzeichen."
Exit Sub
End If
'Objekt ID
If ComboBox2.Value = "" Then
MsgBox "Bitte wähle noch eine Objekt ID."
Exit Sub
End If
'Grund der Intervention
If ComboBox3.Value = "" Then
MsgBox "Bitte wähle noch den Grund der Intervention."
Exit Sub
End If
'Anzeige GMA
If TextBox1.Value = "" Then
MsgBox "Bitte trage noch den Anzeigetext der GMA ein."
Exit Sub
End If
'Objektkontrolle
If CheckBox1 = False Then
Dim a As String
a = MsgBox("Wurde ein Objektkontrolle durchgeführt?", vbYesNo, "Abfrage")
If a = vbNo Then
MsgBox "Dann bitte in den Maßnahmen erläutern"
Exit Sub
Else: CheckBox1.Value = True
End If
End If
'Schließbereitschaft
If OptionButton2 = True Then
Dim b As String
b = MsgBox("Wurde die fehlende Schließbereitschaft in den Maßnahmen erläutert?", _
vbYesNo, "Abfrage")
If b = vbNo Then
MsgBox "Dann bitte in den Maßnahmen erläutern"
Exit Sub
End If
End If
'Maßnahmen
If TextBox2.Value = "" Then
MsgBox "Bitte trage noch deine Maßnahmen ein."
Exit Sub
End If
'Zeit
If DTPicker3.Value = "00:00:00" Then
MsgBox "Bitte trage noch deine Stunden ein."
Exit Sub
End If
'Einsatz Fahrzeug
If TextBox3.Value = "" Then
MsgBox "Bitte wähle noch ein Einsatzfahrzeug aus."
Exit Sub
End If
'Einsatzkräfte
If TextBox4.Value = "" Then
MsgBox "Bitte trage noch die erste Interventionskraft ein."
Exit Sub
End If
'Einsatzkräfte
If TextBox5.Value = "" Then
MsgBox "Bitte trage noch die zweite Interventionskraft ein."
Exit Sub
End If
'Hier wird abgefragt ob die Werte richtig sind
Dim c As String
c = MsgBox("Ist alles richtig ausgefüllt?", vbYesNo, "Abfrage")
If c = vbNo Then
MsgBox "Bitte überprüfen"
Exit Sub
End If
'Hier werden die Werte in die jeweiligen Zellen geschrieben
Range("G5") = Label2.Caption
Range("G9") = ComboBox1.Value
Range("I10") = Label6.Caption
Range("D17") = ComboBox2.Value
Range("D19") = ComboBox3.Value
Range("D21") = DTPicker1.Value
Range("K21") = DTPicker2.Value
Range("D25") = TextBox1.Text
Range("D32") = TextBox2.Text
Range("D34") = DTPicker3.Value
Range("D37") = TextBox3.Text
Range("D39") = TextBox4.Text
Range("D41") = TextBox5.Text
If CheckBox1 = True Then
Range("A26") = "a"
End If
If OptionButton1 = True Then
Range("A27") = "a"
End If
If OptionButton2 = True Then
Range("A28") = "a"
End If
'In Datenbank schreiben
Worksheets("Datenbank").Visible = True
Worksheets("Datenbank").Activate
'In die erste freie Zeile schreiben
Dim Zeile As Integer
Zeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(Zeile, 1) = Format(DTPicker1.Value, "dd.mm.yy") & ", " & Format(DTPicker2.Value, "hh: _
mm")
Cells(Zeile, 2) = ComboBox2.Value
Cells(Zeile, 3) = Format(DTPicker3.Value, "hh:mm")
Cells(Zeile, 4) = TextBox4.Text & "; " & TextBox5.Text
Cells(Zeile, 5) = ComboBox3.Value
Cells(Zeile, 6) = ComboBox1.Value
Worksheets("Intervention").Activate
'Userform schließen
Unload UserForm1
'per Mail senden an Empfänger aus Zelle G10 und Datenblatt leeren
Call SendSheetAsPDF
Call leeren
'Excel Beenden
Worksheets("Intervention").Visible = False
Worksheets("Datenbank").Visible = False
ThisWorkbook.Save
ActiveWorkbook.Close
End Sub
'Klick-Ereignis in der Userform. Hier wird das Makro Eintragen gestartet.
'***************************************************************************
Private Sub CommandButton1_Click()
Call Eintragen
End Sub
'Klick-Ereignis in der Userform. Hier wird das Excel beendet.
'***************************************************************************
Private Sub CommandButton2_Click()
ActiveWorkbook.Close
End Sub
Für eure Anregungen wäre ich sehr dankbar!
Falls ihr Verbesserung im Code seht, könnt ihr mir das auch sehr gerne schreiben.
Vielen Dank im Voraus
Gruß Tim