Sub VSHAPE()
Dim startws, voor, wbs, ws45top, ws55top, ws65top, ws45bod, ws55bod, ws65bod, invoer As Worksheet
Dim GB, HVVShape, HL1, HS, BHS, Af2L1L As Integer
Dim Hschuif, Vschuif, kooi, Kolstart, Kolend, KHoogte As String
Dim naam, naam2 As String
Dim LastRowR As String
Dim ws, wsb As Worksheet
Set startwb = ThisWorkbook
Set ws45top = startwb.Sheets("top voergoot (45)")
Set ws55top = startwb.Sheets("top voergoot (55)")
Set ws65top = startwb.Sheets("top voergoot (65)")
Set ws45bod = startwb.Sheets("bodem voergoot (45)")
Set ws55bod = startwb.Sheets("bodem voergoot (55)")
Set ws65bod = startwb.Sheets("bodem voergoot (65)")
Set invoer = startwb.Sheets("Input")
Set berekening = startwb.Sheets("Top")
Set berekening2 = startwb.Sheets("Bod")
Af2L1L = invoer.Range("C1") 'Afstand tussen 2 lampen 1 hoogte
HS = invoer.Range("C2") 'Hoogte systeem
GB = invoer.Range("C4") 'Gangpad breedte
HL1 = invoer.Range("C5") 'LEEG
HVVShape = invoer.Range("C6") 'V-shape hoogte verschil
Hkooi = invoer.Range("C8") 'Kooihoogte
Optimal = invoer.Range("C10") 'Optimale lamphoogte?
LV = invoer.Range("C11") 'lamp hoogte tov voergoot
Hschuif = Af2L1L / 5 'Verschuiving tussen 2 lampen (hoeveel stappen (per 5 cm)) (BREEDTE, HORIZONTAAL)
HVSschuif = Af2L1L / 10 'Verschuiving voor V-shapein aantal stappen (per 5 cm) de helft dan voor 1 hoogte om de eerste verschuiving te weten (BREEDTE, HORIXONTAAL
Vschuif = HVVShape / 5 'Verschuiving in de hoogte voor V-shape in aantal stappen (per 5 cm) (HOOGTE, VERTIKAAL)
Kolstart = 176 - Hschuif 'Vanaf waar moet ik reken om een goed gemiddelde te berekenen (176 is midden en dan de verschuiving reklening houdend
Kolend = 176 + Hschuif 'zie vorige
KHoogte = Hkooi / 5 'Kooi hoogte in aantal stappen (per 5 cm)
LVS = LV / 5 'Lamp hoogte tov voergoot in aantal stappen (per 5 cm)
BHS = HS / 5 'aantal stappen tot einde systeem
''''''''''''''''AM19 start van beeld''''''''''''''''''''
Set startws = ThisWorkbook.Worksheets("Input")
If GB = 90 Then
'als gangbreedte = 90cm (45cm) dan
MsgBox "90"
If Optimal = "JA" Then
kooi = 35
kooi2 = 38
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-0.9 TV k-" & Hkooi
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-0.9 BV k-" & Hkooi
Else
kooi = 26 + LVS
kooi2 = 29 + LVS
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-0.9 TV k-" & Hkooi & " LV" & LV
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-0.9 BV k-" & Hkooi & " LV" & LV
End If
If SheetExists(naam) Then
MsgBox "Exists"
Else
MsgBox "Doesnt exist"
End If
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam
Set wsb = startwb.Sheets(naam)
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam2
Set wsb2 = startwb.Sheets(naam2)
ws45top.Range("AM19:GE115").Copy
berekening.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
ws45bod.Range("AM19:GE115").Copy
berekening2.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Else
If GB = 110 Then
'als gangbreedte = 110cm (55cm) dan
MsgBox "110"
If Optimal = "JA" Then
kooi = 38
kooi2 = 41
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.1 TV k-" & Hkooi
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.1 BV k-" & Hkooi
Else
kooi = 26 + LVS
kooi2 = 29 + LVS
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.1 TV k-" & Hkooi & " LV" & LV
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.1 BV k-" & Hkooi & " LV" & LV
End If
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam
Set wsb = startwb.Sheets(naam)
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam2
Set wsb2 = startwb.Sheets(naam2)
ws55top.Range("AM19:GE115").Copy
berekening.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
ws55bod.Range("AM19:GE115").Copy
berekening2.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Else
If GB = 130 Then
'als gangbreedte = 130 cm (65cm) dan
MsgBox "130"
If Optimal = "JA" Then
kooi = 41
kooi2 = 44
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.3 TV k-" & Hkooi
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.3 BV k-" & Hkooi
Else
kooi = 26 + LVS
kooi2 = 29 + LVS
naam = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.3 TV k-" & Hkooi & " LV" & LV
naam2 = "VS " & Af2L1L / 100 & "-" & HVVShape / 100 & "-1.3 BV k-" & Hkooi & " LV" & LV
End If
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam
Set wsb = startwb.Sheets(naam)
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = naam2
Set wsb2 = startwb.Sheets(naam2)
ws65top.Range("AM19:GE115").Copy
berekening.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
ws65bod.Range("AM19:GE115").Copy
berekening2.Range("KK200").PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Else
'als geen van de bovenstaande waar is dan
MsgBox "Geen correcte gangbreedte ingevoerd"
Exit Sub
End If
End If
End If
''''''''''''''''''''''''
'''''''''Top''''''''''''
''''''''''''''''''''''''
berekening.Range("Lamp").Copy
wsb.Range("B2").PasteSpecial (xlPasteValuesAndNumberFormats)
berekening.Range("Lamp").Offset(0, Hschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(0, -Hschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(0, Hschuif + Hschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(0, -Hschuif - Hschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
''''''''''' VANAF HIER IS HET VOOR VSHAPE''''''''''''''''''''''''''''''
berekening.Range("Lamp").Offset(-Vschuif, HVSschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(-Vschuif, -HVSschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(-Vschuif, Hschuif + HVSschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening.Range("Lamp").Offset(-Vschuif, -HVSschuif - Hschuif).Copy
wsb.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
Application.CutCopyMode = False
Set Slack = wsb.Range("B2:MQ98")
Application.ScreenUpdating = False
wsb.Columns("B:MQ").ColumnWidth = 2.14
Slack.FormatConditions.AddColorScale ColorScaleType:=2
Slack.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueNumber
Slack.FormatConditions(1).ColorScaleCriteria(1).Value = 0
With Slack.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
Slack.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValueNumber
Slack.FormatConditions(1).ColorScaleCriteria(2).Value = 200
With Slack.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 65535
.TintAndShade = 0
End With
With Slack.Font
.Name = "Calibri"
.Size = 11
End With
Slack.NumberFormat = "0"
wsb.Activate
Application.ScreenUpdating = True
wsb.Range("A2").Value = -120
wsb.Range("A3").Value = -115
wsb.Range("B1").Value = -870
wsb.Range("C1").Value = -865
wsb.Range("A2:A3").AutoFill Destination:=Range("A2:A98"), Type:=xlFillDefault
wsb.Range("B1:C1").AutoFill Destination:=Range("B1:ML1"), Type:=xlFillDefault
With wsb.Range("B1:QC1")
.Orientation = 90
End With
wsb.Range("B1:C1").RowHeight = 60.75
wsb.Range("A1").Select
With Columns(Kolstart).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With
With Columns(Kolend).Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With
With Rows(kooi).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
With Rows(kooi - KHoogte / 2).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With Rows(kooi - KHoogte / 2 + BHS).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
wsb.Range("MS1") = ""
wsb.Range("MT1") = "Gemiddelde"
wsb.Range("MU1") = "St Dev"
wsb.Range("MW1") = "St Dec/ gemiddelde"
wsb.Range("MZ1") = "Max"
wsb.Range("NA1") = "Min"
wsb.Range("NC1") = "Min/Max"
wsb.Range("MS2") = "=IF(RC[1]="""","""",MAX(R1C357:R[-1]C)+1)"
wsb.Range("MS2").AutoFill Destination:=Range("MS2:MS98"), Type:=xlFillValues
Do While kooi < 99
wsb.Range("MT" & kooi).FormulaR1C1 = "=AVERAGE(RC" & Kolstart & ":RC" & Kolend & ")"
wsb.Range("MU" & kooi).FormulaR1C1 = "=STDEV.P(RC" & Kolstart & ":RC" & Kolend & ")"
wsb.Range("MW" & kooi).Formula = "=MU" & kooi & "/MT" & kooi
wsb.Range("MZ" & kooi).FormulaR1C1 = "=MAX(RC" & Kolstart & ":RC" & Kolend & ")"
wsb.Range("NA" & kooi).FormulaR1C1 = "=MIN(RC" & Kolstart & ":RC" & Kolend & ")"
wsb.Range("NC" & kooi).Formula = "=NA" & kooi & "/MZ" & kooi
With Rows(kooi + KHoogte).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
kooi = kooi + KHoogte
Loop
wsb.Columns("MT:NC").NumberFormat = "0.00"
wsb.Columns("MT:NC").AutoFit
''''Deze werken maar mss niet handig vooraf al aan te zetten
'wsb.Range(Cells(1, 2), Cells(1, Kolstart - 2)).EntireColumn.Hidden = True
'wsb.Range(Cells(1, Kolend + 2), Cells(1, 351)).EntireColumn.Hidden = True
''''''''''''''''''''''''
'''''''''Bod''''''''''''
''''''''''''''''''''''''
berekening2.Range("Lamp2").Copy
wsb2.Range("B2").PasteSpecial (xlPasteValuesAndNumberFormats)
berekening2.Range("Lamp2").Offset(0, Hschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(0, -Hschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(0, Hschuif + Hschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(0, -Hschuif - Hschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
'''''''''' VANAF HIER IS HET VOOR VSHAPE''''''''''''''''''''''''''''''
berekening2.Range("Lamp2").Offset(-Vschuif, HVSschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(-Vschuif, -HVSschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(-Vschuif, Hschuif + HVSschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
berekening2.Range("Lamp2").Offset(-Vschuif, -HVSschuif - Hschuif).Copy
wsb2.Range("B2").PasteSpecial Operation:=xlPasteSpecialOperationAdd
Application.CutCopyMode = False
Set Slack2 = wsb2.Range("B2:MQ98")
Application.ScreenUpdating = False
wsb2.Columns("B:MQ").ColumnWidth = 2.14
Slack2.FormatConditions.AddColorScale ColorScaleType:=2
Slack2.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueNumber
Slack2.FormatConditions(1).ColorScaleCriteria(1).Value = 0
With Slack2.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
Slack2.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValueNumber
Slack2.FormatConditions(1).ColorScaleCriteria(2).Value = 200
With Slack2.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 65535
.TintAndShade = 0
End With
With Slack2.Font
.Name = "Calibri"
.Size = 11
End With
Slack2.NumberFormat = "0"
wsb2.Activate
Application.ScreenUpdating = True
wsb2.Range("A2").Value = -120
wsb2.Range("A3").Value = -115
wsb2.Range("B1").Value = -870
wsb2.Range("C1").Value = -865
wsb2.Range("A2:A3").AutoFill Destination:=Range("A2:A98"), Type:=xlFillDefault
wsb2.Range("B1:C1").AutoFill Destination:=Range("B1:ML1"), Type:=xlFillDefault
With wsb2.Range("B1:QC1")
.Orientation = 90
End With
wsb2.Range("B1:C1").RowHeight = 60.75
wsb2.Range("A1").Select
With Columns(Kolstart).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With
With Columns(Kolend).Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With
With Rows(kooi2).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
With Rows((kooi2 - KHoogte / 2) - 3).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
With Rows((kooi2 - KHoogte / 2 + BHS) - 3).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
wsb2.Range("MT1") = "Gemiddelde"
wsb2.Range("MU1") = "St Dev"
wsb2.Range("MW1") = "St Dec/ gemiddelde"
wsb2.Range("MZ1") = "Max"
wsb2.Range("NA1") = "Min"
wsb2.Range("NC1") = "Min/Max"
wsb2.Range("MS2") = "=IF(RC[1]="""","""",MAX(R1C357:R[-1]C)+1)"
wsb2.Range("MS2").AutoFill Destination:=Range("MS2:MS98"), Type:=xlFillValues
Do While kooi2 < 99
wsb2.Range("MT" & kooi2).FormulaR1C1 = "=AVERAGE(RC" & Kolstart & ":RC" & Kolend & ")"
wsb2.Range("MU" & kooi2).FormulaR1C1 = "=STDEV.P(RC" & Kolstart & ":RC" & Kolend & ")"
wsb2.Range("MW" & kooi2).Formula = "=MU" & kooi2 & "/MT" & kooi2
wsb2.Range("MZ" & kooi2).FormulaR1C1 = "=MAX(RC" & Kolstart & ":RC" & Kolend & ")"
wsb2.Range("NA" & kooi2).FormulaR1C1 = "=MIN(RC" & Kolstart & ":RC" & Kolend & ")"
wsb2.Range("NC" & kooi2).Formula = "=NA" & kooi2 & "/MZ" & kooi2
With Rows(kooi2 + KHoogte).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
kooi2 = kooi2 + KHoogte
Loop
With wsb2.Range("MW1")
.WrapText = True
.Orientation = 90
End With
With wsb.Range("MW1")
.WrapText = True
.Orientation = 90
End With
wsb2.Columns("MT:NC").NumberFormat = "0.00"
wsb2.Columns("MT:NC").AutoFit
''''Deze werken maar mss niet handig vooraf al aan te zetten
'wsb2.Range(Cells(1, 2), Cells(1, Kolstart - 2)).EntireColumn.Hidden = True
'wsb2.Range(Cells(1, Kolend + 2), Cells(1, 351)).EntireColumn.Hidden = True
End Sub