Option Explicit
Public Sub AddRecord( _
Wert1 As Variant, _
Wert2 As Variant, _
Wert3 As Variant _
)
Dim wksFehlersammelliste As Excel.Worksheet
Set wksFehlersammelliste = GetFehlersammelliste().Worksheets("Tabelle xyz")
Dim rngCell As Excel.Range
Set rngCell = wksFehlersammelliste.Cells(wksFehlersammelliste.Rows.Count, "A").End(xlUp)
Set rngCell = rngCell.Offset(RowOffset:=1)
wksFehlersammelliste.Cells(rngCell.Row, "A").Value = Wert1
wksFehlersammelliste.Cells(rngCell.Row, "B").Value = Wert2
wksFehlersammelliste.Cells(rngCell.Row, "C").Value = Wert3
Call SaveFehlersammelliste
End Sub
Public Sub SaveFehlersammelliste()
Call GetFehlersammelliste().Save
End Sub
Public Sub CloseFehlersammelliste()
Dim wkb As Excel.Workbook
On Error Resume Next
Set wkb = Workbooks("Fehlersammelliste.xlsx")
On Error GoTo 0
If wkb Is Nothing Then
Exit Sub
End If
Call wkb.Close(SaveChanges:=True)
End Sub
Private Function GetFehlersammelliste() As Excel.Workbook
Dim wkb As Excel.Workbook
On Error Resume Next
Set wkb = Workbooks("Fehlersammelliste.xlsx")
On Error GoTo 0
If wkb Is Nothing Then
Dim strFullFilename As String
strFullFilename = IIf(Right$(ThisWorkbook.Path, 1) <> "\", ThisWorkbook.Path & "\", ThisWorkbook.Path)
strFullFilename = strFullFilename & "Fehlersammelliste.xlsx"
On Error Resume Next
Dim errorCode As Long
Application.ScreenUpdating = False
Set wkb = Workbooks.Open(strFullFilename)
wkb.Windows(1).Visible = False
Application.ScreenUpdating = True
errorCode = Err.Number
On Error GoTo 0
If wkb Is Nothing Then
Call Err.Raise(errorCode, Description:="Die Mappe '" & strFullFilename & "' konnte nicht geöffnet werden - existiert diese?")
End If
End If
Set GetFehlersammelliste = wkb
End Function