Falls es eine einfache methode gibt daten zu posten sag es mir bitte, bin neu hier:
Word datei
Option Explicit
Private Sub DateienImportieren()
Dim AuswahlDatei As String
Dim AppExcel As Excel.Application
Dim wbkExcel As Excel.Workbook
Dim wksExcel As Excel.Worksheet
Dim rngExcel As Excel.Range
Dim rngZeile As Excel.Range
Dim Kopieren As Object
Dim appWord As Object
Dim sWorkbook As Object
Dim i As Long
i = 1
Do
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excelfiles", "*.xlsx", 1
.Title = "Bitte die Prüfungsdateien des Dozenten jeweils Einzeln auswählen, zum Beenden Bitte abbrechen drücken!!"
.InitialFileName = ActiveDocument.Path & "\Pruefungen_nach_Dozent\"
If .Show = -1 Then
'ok clicked
AuswahlDatei = .SelectedItems(1)
Set AppExcel = Excel.Application
Set wbkExcel = AppExcel.Workbooks.Open(AuswahlDatei, , , , , , , , , , , , False)
Set wksExcel = wbkExcel.Worksheets("Pruefungen")
Set rngExcel = wksExcel.UsedRange
Range(rngExcel.AddressLocal).Copy
ActiveDocument.Bookmarks("TextmarkeAllePruefungen").Range.Paste
Set AppExcel = Nothing
Set wbkExcel = Nothing
Set wksExcel = Nothing
Set rngExcel = Nothing
Set Kopieren = Nothing
Call DateienImportieren
Else
'cancel clicked
End If
End With
i = 2
Loop Until i = 2
End Sub
ExcelDatei:
Option Explicit
Private Sub UserForm_Initialize()
With Me.ListBoxBAMA
.AddItem "Bachelor"
.AddItem "Master"
.Value = "Bachelor"
End With
Dim i As Integer
With Me.ComboBoxTag
For i = 1 To 31
.AddItem CStr(i)
Next
End With
With Me.ComboBoxMonat
.AddItem "Januar"
.AddItem "Februar"
.AddItem "März"
.AddItem "April"
.AddItem "Mai"
.AddItem "Juni"
.AddItem "Juli"
.AddItem "August"
.AddItem "September"
.AddItem "Oktober"
.AddItem "November"
.AddItem "Dezember"
End With
With Me.ComboBoxJahr
For i = 2017 To 2025
.AddItem CStr(i)
Next
End With
With Me.ComboBoxStunden
.AddItem "00"
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
For i = 10 To 23
.AddItem CStr(i)
Next
End With
With Me.ComboBoxMinuten
.AddItem "00"
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
For i = 10 To 59
.AddItem CStr(i)
Next
End With
End Sub
Private Sub Abbrechen_Click()
Unload Me
End Sub
Private Function errorsInForm() As String
Dim msg As String
msg = ""
If Not IsNumeric(TextBoxVNR.Value) Or TextBoxVNR.Value = "" Then
msg = msg & "Die Veranstaltungsnummer hat das falsches Format! Bitte nur Zahlen eingeben! Bsp. 12345 " & vbCrLf
End If
Dim TextBoxVNRNEU As String
Dim j As Integer
TextBoxVNRNEU = TextBoxVNR
For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row + 1
If Cells(j, 2) = TextBoxVNRNEU Then msg = msg & "Die Veranstaltungsnummer wurde schon einmal vergeben! Bitte überprüfen Sie ihre Eingabe! Bsp. 12345 " & vbCrLf
Next
If TextBoxName.Value = "" Then
msg = msg & "Der Veranstaltungsname muss eingegeben werden! Bitte wiederholen! " & vbCrLf
End If
If Not IsNumeric(ComboBoxTag.Value) Or ComboBoxTag.Value = "" Then
msg = msg & "Der Tag der Prüfung hat ein falsches Format! Bitte nur Zahlen eingeben! Bsp. 17 " & vbCrLf
Else
If ComboBoxTag.Value >= 32 Or ComboBoxTag.Value <= 0 Then
msg = msg & "Der Tag der Prüfung hat einen ungültigen Wert! Bitte nur Zahlen zwischen 1 und 31 eingeben! " & vbCrLf
End If
End If
If IsNumeric(ComboBoxMonat.Value) Or ComboBoxMonat.Value = "" Then
msg = msg & "Der Monat der Prüfung hat ein falsches Format! Bitte nur Buchstaben eingeben! Bsp. Juni " & vbCrLf
Else
If Not (ComboBoxMonat.Value = "Januar" Or ComboBoxMonat.Value = "Februar" Or ComboBoxMonat.Value = "März" Or ComboBoxMonat.Value = "April" Or ComboBoxMonat.Value = "Mai" Or ComboBoxMonat.Value = "Juni" Or ComboBoxMonat.Value = "Juli" Or ComboBoxMonat.Value = "August" Or ComboBoxMonat.Value = "September" Or ComboBoxMonat.Value = "Oktober" Or ComboBoxMonat.Value = "November" Or ComboBoxMonat.Value = "Dezember") Then
msg = msg & "Der Monat der Prüfung hat eine falsche Eingabe! Bitte nur gültige Monate eingeben! Bsp. Juni " & vbCrLf
End If
End If
If (ComboBoxTag.Value = 31 And (ComboBoxMonat.Value = "Februar" Or ComboBoxMonat.Value = "April" Or ComboBoxMonat.Value = "Juni" Or ComboBoxMonat.Value = "September" Or ComboBoxMonat.Value = "November")) Then
msg = msg & "Nicht jeder Monat hat 31 Tage! Bitte den Tag des Prüfungsdatums korregieren " & vbCrLf
End If
If ComboBoxTag.Value = 30 And ComboBoxMonat.Value = "Februar" Then
msg = msg & "Der Februar hat 28 Tage! Bitte den Tag des Prüfungsdatums korregieren " & vbCrLf
End If
If ComboBoxTag.Value = 29 And ComboBoxMonat.Value = "Februar" Then
msg = msg & "Der Februar hat 28 Tage! Bitte den Tag des Prüfungsdatums korregieren " & vbCrLf
End If
If Not IsNumeric(ComboBoxJahr.Value) Or ComboBoxJahr.Value = "" Then
msg = msg & "Das Jahr der Prüfung hat ein falsches Format! Bitte nur Zahlen eingeben! Bsp. 2018 " & vbCrLf
Else
If ComboBoxJahr.Value >= 2026 Or ComboBoxJahr.Value <= 2016 Then
msg = msg & "Das Jahr der Prüfung hat einen ungültigen Wert! Bitte nur Zahlen zwischen 2017 und 2025 eingeben! " & vbCrLf
End If
End If
If Not IsNumeric(ComboBoxStunden.Value) Or ComboBoxStunden.Value = "" Then
msg = msg & "Der Stundenbereich hat ein ungültiges Format! Bitte nur Zahlen eingeben von 00-23!" & vbCrLf
Else
If ComboBoxStunden.Value >= 24 Or ComboBoxStunden.Value <= -1 Then
msg = msg & "Die Stundenanzahl der Prüfung hat einen ungültigen Wert! Bitte nur Zahlen zwischen 00 und 23 eingeben! " & vbCrLf
End If
End If
If Not IsNumeric(ComboBoxMinuten.Value) Or ComboBoxMinuten.Value = "" Then
msg = msg & "Sie haben eine ungültige Uhrzeit im Minutenbereich eingeben! Bitte nur Zahlen eingeben von 00-59!" & vbCrLf
Else
If ComboBoxMinuten.Value >= 60 Or ComboBoxMinuten.Value <= -1 Then
msg = msg & "Die Minutenanzahl hat einen ungültigen Wert! Bitte nur Zahlen zwischen 00 und 59 eingeben! " & vbCrLf
End If
End If
If Not IsNumeric(TextBoxDauer.Value) Or TextBoxDauer.Value = "" Then
msg = msg & "Die Dauer der Prüfung hat das falsches Format! Bitte nur Zahlen eingeben! Bsp. 90 " & vbCrLf
End If
errorsInForm = msg
End Function
Private Sub Eintragen_Click()
Dim VNummer As Long
Dim NameV As String
Dim BAMA As String
Dim Datum As Date
Dim Uhrzeit As Variant
Dim Dauer As String
Dim freieZeileVNummer As Long
Dim freieZeileNameV As Long
Dim freieZeileBAMA As Long
Dim freieZeileDatum As Long
Dim freieZeileUhrzeit As Long
Dim freieZeileDauer As Long
Dim err As String
err = errorsInForm()
If err <> "" Then
MsgBox err, vbCritical, "Fehler bei Ihrer Eingabe in das Formular"
Exit Sub
End If
freieZeileVNummer = Cells(Rows.Count, 2).End(xlUp).Row + 1
freieZeileNameV = Cells(Rows.Count, 3).End(xlUp).Row + 1
freieZeileBAMA = Cells(Rows.Count, 4).End(xlUp).Row + 1
freieZeileDatum = Cells(Rows.Count, 5).End(xlUp).Row + 1
freieZeileUhrzeit = Cells(Rows.Count, 6).End(xlUp).Row + 1
freieZeileDauer = Cells(Rows.Count, 7).End(xlUp).Row + 1
VNummer = TextBoxVNR
NameV = TextBoxName
BAMA = ListBoxBAMA
Datum = ComboBoxTag & "." & ComboBoxMonat & "." & ComboBoxJahr
Uhrzeit = ComboBoxStunden & ":" & ComboBoxMinuten & " Uhr"
Dauer = TextBoxDauer & " min"
Sheets("Pruefungen").Cells(freieZeileVNummer, 2) = VNummer
Sheets("Pruefungen").Cells(freieZeileNameV, 3) = NameV
Sheets("Pruefungen").Cells(freieZeileBAMA, 4) = BAMA
Sheets("Pruefungen").Cells(freieZeileDatum, 5) = Datum
Sheets("Pruefungen").Cells(freieZeileUhrzeit, 6) = Uhrzeit
Sheets("Pruefungen").Cells(freieZeileDauer, 7) = Dauer
Unload Me
UserForm1.Show
End Sub
Private Sub Fertig_Click()
Dim DozentName As String
Dim freieZeileDozent As Long
Unload Me
DozentName = InputBox("Bitte tragen Sie ihren Nachnamen ein!")
freieZeileDozent = Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Pruefungen").Cells(freieZeileDozent, 1) = DozentName
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\Pruefungen_nach_Dozent\" & DozentName, FileFormat:=xlOpenXMLWorkbook
Application.Quit
End Sub
Private Sub Workbook_Open()
UserForm1.Show
End Sub
|