Function jechane()
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Activate
If ActiveSheet.Name <> "NAPIER" And ActiveSheet.Name <> "Progress" And ActiveSheet.Name <> "Interpolation Values" Then usun
Sheets("NAPIER").Select
Application.ScreenUpdating = False
wheelbase = 8.5
minlevel = Range("B3")
Range("A4").Select
zasieg = 20 / (Cells(Rows.Count, 1).End(xlUp).Row - 2)
ilosc = Cells(Rows.Count, 1).End(xlUp).Value * 10 + 2
licznik = 1
Sheets("Interpolation Values").Visible = True
Sheets("Progress").Visible = True
Sheets("Progress").Range("A10:U10").ClearContents
Sheets("Progress").Range("A1").ClearContents
Application.Calculation = xlCalculationManual
Do Until ActiveCell.Offset(1, 0).Value = ""
wheelbase = 8.5
chain = ActiveCell.Value
level = ActiveCell.Offset(0, 1).Value
Sheets("Interpolation Values").Select
Sheets("Interpolation Values").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = chain
Sheets(Sheets.Count).Activate
Range("A3:D4").Select
Selection.AutoFill Destination:=Range(Cells(3, 1), Cells(ilosc, 4)), Type:=xlFillDefault
Range(Cells(3, 1), Cells(ilosc, 4)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
qqrq:
Cells(Rows.Count, 12).End(xlUp).Select
ActiveCell.Offset(-1, 0).Select
wiersz2 = ActiveCell.Row
Cells(wiersz2, 6).Value = level
Cells(wiersz2, 7).Value = chain
Cells(wiersz2, 8).Value = wheelbase
Cells(wiersz2 + 1, 8).Value = wheelbase
'Range("F3").Value = level
'Range("G3").Value = chain
'Range("H3").Value = wheelbase
ActiveCell.Value = 0.1
ActiveCell.Offset(0, 1).Value = wheelbase - 0.1
Do Until ActiveCell.Value = wheelbase - 0.1 Or ActiveCell.Value = chain
ActiveCell.Offset(1, 0).Value = ActiveCell.Value + 0.1
ActiveCell.Offset(1, 1).Value = ActiveCell.Offset(0, 1).Value - 0.1
ActiveCell.Offset(1, 0).Select
Loop
wiersz = ActiveCell.Row
Range(Cells(wiersz2, 8), Cells(wiersz2 + 1, 11)).Select
Selection.AutoFill Destination:=Range(Cells(wiersz2, 8), Cells(wiersz, 11)), Type:=xlFillDefault
Range(Cells(wiersz2, 14), Cells(wiersz2 + 1, 27)).Select
Selection.AutoFill Destination:=Range(Cells(wiersz2, 14), Cells(wiersz, 27)), Type:=xlFillDefault
Range(Cells(wiersz2, 8), Cells(wiersz, 27)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
If wheelbase <> 15.3 Then
Cells(Rows.Count, 12).End(xlUp).Select
ActiveCell.Offset(4, -6).Select
wiersz2 = ActiveCell.Row
Range(Cells(3, 6), Cells(4, 27)).Copy Range(Cells(wiersz2, 6), Cells(wiersz2 + 1, 27))
If wheelbase = 9.75 Then wheelbase = 15.3
If wheelbase = 8.5 Then wheelbase = 9.75
GoTo qqrq
End If
Range("A3").Select
postep = zasieg * licznik
Sheets("Progress").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Cells(10, Round(postep, 0) + 1).Value = 1
Range("K12").Value = licznik / (20 / zasieg)
Application.ScreenUpdating = False
Sheets("NAPIER").Select
ActiveCell.Offset(1, 0).Select
licznik = licznik + 1
Loop
Sheets("Progress").Select
Application.ScreenUpdating = True
Cells(10, 21).Value = 1
Range("K12").Value = 1
a = MsgBox("Completed", vbOKOnly, "Congratulations!")
Application.ScreenUpdating = False
Sheets("NAPIER").Select
Range("A3").Select
Sheets("Interpolation Values").Visible = False
Sheets("Progress").Visible = False
End Function
Function usun()
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Activate
If ActiveSheet.Name <> "NAPIER" And ActiveSheet.Name <> "Progress" And ActiveSheet.Name <> "Interpolation Values" Then
a = MsgBox("Do You want to delete results sheets and recalculate the project?", vbOKCancel, "Warning")
If a = vbOK Then
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Do Until ActiveSheet.Name = "NAPIER"
Sheets(Sheets.Count).Select
If ActiveSheet.Name <> "NAPIER" Or ActiveSheet.Name <> "Progress" Or ActiveSheet.Name <> "Interpolation Values" Then
Sheets(Sheets.Count).Delete
End If
Loop
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Sheets("NAPIER").Select
Else
Sheets("NAPIER").Select
Exit Function
End If
Else
If Sheets.Count = 3 Then a = MsgBox("No resluts sheets found", vbOKOnly, "Warning")
End If
End Function