|
Hallo zusammen,
vielleicht könnt ihr mir ja helfen, da ich zu diesem Thema leider nach langer Suche immer noch nichts gefunden habe:
Problem:
Nachdem ich durch ein Formular (siehe unten, in diesem trägt man Daten ein die auf einer Übersichtseite eingetragen sowie auf einem neuen Blatt eingetragen werden) durch eine Vorlage ein neues Tabellenblatt (Worksheet 2) aufgemacht habe, möchte ich nun beliebige Werte in eine beliebige Zeile eintragen. Allerdings werden die Werte nur auf Worksheet(1) in der Zeile übertragen in die ich die Werte in Worksheet 2 übertrage (händisch nach dem Ablauf des Formulars).
Nachdem ich Worksheet 1 geöffnet mit der Hand geöffnet und dann wieder zu Worksheet 2 gegangen bin funktioniert alles wie es soll.
Wie bekomme ich das weg damit ich direkt werte Eintragen kann? (Einfach durch Programmierung hin und her springen funktioniert hier leider nicht)
PS: Ich weiß das mein Code recht unsauber geschrieben ist, da ich aber ohne Vorkenntnisse an die Sache ran bin und es jetzt funktioniert würde es reichen nur auf diesen einen Fehler einzugehen :-)
Vielen Dank schon einmal im Vorraus!!!
Private Sub ButtonNeuesProjektErstellen_Click()
' Variablen definieren
Dim Tabellenname As String
Dim Projektnummer As String
Dim Verantwortlich As String
Dim Projektname As String ' Projektnummer wurde auf dem Surface durch XEN ersetzt.
Dim Kunde As String
Dim Name As String
Dim Email As String
Dim Telefon As String
Dim AdresseStandort As String
Dim irow As Integer
Dim Link As String
' Durch Eingabefelder Variablen befüllen
Projektnummer = TBProjektnummer.Text
Verantwortlich = TBVerantwortlich.Text
Projektname = TBProjektname.Text
Kunde = TBKunde.Text
Name = TBName.Text
Email = TBEmail.Text
Telefon = TBTelefon.Text
AdresseStandort = TBAdresseStandort.Text
' Gleichsetzten von Variablen
Link = Projektnummer
Tabellenname = Link
'auf doppelten Tabellennamen prüfen
If Link = "" Then
FormNeuesProjekt.Hide
Exit Sub
End If
irow = 8
Do Until IsEmpty(ActiveSheet.Cells(irow, 1))
ActiveSheet.Cells(irow, 1).Select
If Link = ActiveSheet.Cells(irow, 1).Value Then
MsgBox "Achtung, der Bericht existiert schon. Bitte eine andere Projektnummereingeben."
'Neues_Projekt_erstellen.Show
Exit Sub
End If
irow = irow + 1
Loop
'Blattschutz aufheben
ActiveSheet.Unprotect
ActiveWorkbook.Unprotect
'Vorlage kopieren
Sheets("Vorlage - Projekt").Copy after:=Worksheets(1)
' Anderes Tabellenblatt auswählen
Worksheets(2).Select
'Neue Tabelle benennen
Tabellenname = WorksheetFunction.Substitute(Tabellenname, " ", "_")
ActiveSheet.Name = Tabellenname
' Anderes Tabellenblatt auswählen
Worksheets(1).Select
'Leere Zeile suchen
irow = 9
Do Until IsEmpty(ActiveSheet.Cells(irow, 1))
ActiveSheet.Cells(irow, 1).Select
irow = irow + 1
Loop
'Zeile einfügen
ActiveSheet.Rows(irow).Copy
ActiveSheet.Rows(irow).Insert Shift:=xlDown
ActiveSheet.Application.CutCopyMode = False
'Laufnummer wird immer um einen auf die vorherige Zeile aufaddiert in Zeile A
If irow = 10 Then
ActiveSheet.Cells(irow, 1).Value = 1
Else
ActiveSheet.Cells(irow, 1).Value = "=A" + CStr(irow - 1) + "+1"
End If
'Link zu neuer Tabelle
ActiveSheet.Cells(irow, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
Tabellenname + "!B12", TextToDisplay:=Projektnummer
'Verlinkungen eintragen in Übersicht eintragen
Worksheets(1).Select
ActiveSheet.Cells(irow, 3).Value = "=" + Tabellenname + "!C6"
ActiveSheet.Cells(irow, 7).Value = "=" + Tabellenname + "!C3"
ActiveSheet.Cells(irow, 2).Value = "=" + Tabellenname + "!C5"
ActiveSheet.Cells(irow, 4).Value = "=" + Tabellenname + "!A1"
ActiveSheet.Cells(irow, 5).Value = "=" + Tabellenname + "!C7"
ActiveSheet.Cells(irow, 6).Value = "=" + Tabellenname + "!C8"
'Range("irow, 10").Copy
'Range("irow +1, 10").PasteSpecial Paste:=xlAll
'Formdaten eintragen
Worksheets(Tabellenname).Select
ActiveSheet.Range("C6").Value = Projektnummer
ActiveSheet.Range("C5").Value = Verantwortlich
ActiveSheet.Range("A1").Value = Projektname
ActiveSheet.Range("C7").Value = Kunde
ActiveSheet.Range("D12").Value = Name
ActiveSheet.Range("D13").Value = Email
ActiveSheet.Range("D14").Value = Telefon
ActiveSheet.Range("D15").Value = AdresseStandort
GoTo Ende
Ende:
' Formformular schließen
FormNeuesProjekt.Hide
End Sub
Private Sub UserForm_Activate()
' Ist für das Löschen des Inhates aus der Benutzereingabe in dem Formular zuständig
TBProjektnummer.Text = ""
TBVerantwortlich.Text = ""
TBProjektname.Text = ""
TBKunde.Text = ""
TBName.Text = ""
TBEmail.Text = ""
TBTelefon.Text = ""
TBAdresseStandort.Text = ""
End Sub |