Sub Schaltfläche_Datenimport_starten_Klicken()
Dim Drehmoment As Double
Dim Vorspannkraft As Double
Dim Dateipfad As Variant
Dim RngEnde As Range
Dim RwEnde As Long
Application.ScreenUpdating = False
Dateipfad = Application.GetOpenFilename("Alle-Dateien (*.SP8),*.*,", MultiSelect:=True)
Sheets("Variablen").Range("B2").Value2 = UBound(Dateipfad)
laenge = UBound(Dateipfad)
For i = 1 To laenge
On Error Resume Next
Sheets("Versuch " & i).Activate
Cells.Clear
If Err.Number <> 0 Then
ThisWorkbook.Worksheets.Add after:=ActiveSheet
ActiveSheet.Name = "Versuch " & i
End If
On Error GoTo 0
ActiveSheet.Range("R18").Value2 = Right(Dateipfad(i), Len(Dateipfad(i)) - InStrRev(Dateipfad(i), "\"))
Range("A10").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dateipfad(i), Destination:=Range("A2"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 29
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Set RngEnde = _
Cells.Find(What:="Ende", after:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If RngEnde Is Nothing Then Exit Sub
RngEnde.ClearContents
RwEnde = RngEnde.Row - 1
Range("A1").Value = "Drehwinkel [°]"
Range("B1").Value = "Drehmoment [Nm]"
Range("D1").Value = "Vorspannkraft [kN]"
Range("H1").Value = "Reibzahl"
Range("A1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Range("B1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Columns("B:B").Select
Selection.NumberFormat = "0.00"
Range("D1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Columns("D:D").Select
Selection.NumberFormat = "0.00"
Range("H1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Rows("1:1").RowHeight = 23.25
Rows("1:1").Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Columns("C:C").Select
Selection.NumberFormat = "0.00"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Zeit [s]"
Columns("E:E").Select
Selection.NumberFormat = "0.00"
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("A:H").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").Select
Selection.NumberFormat = "0.00"
For j = 2 To RwEnde
On Error Resume Next
Drehmoment = Range("B" & j).Value
Vorspannkraft = Range("D" & j).Value
Range("H" & j) = (((Drehmoment / Vorspannkraft) - (1.25 / (2 * 3.14159))) / ((0.577 * 7.188) + (0.5 * ((8 + 19.5) / 2))))
If Err.Number <> 0 Then
Range("H" & j) = False
End If
On Error GoTo 0
Next j
Next i
Sheets("Zusammenfassung").Select
Application.ScreenUpdating = True
End Sub