' Declare array for values of cylinder-list
' The array-fields are defined as follows
' 0...movement-name
' 1...function description (1 or 2)
' 2...speed of movement
' 3...duration
' 4...consumption
' 5...row of data in cylinder-list
' 6...value 1 or 2 (depending on if it is sol1 or sol2)
' 7...
' 8...
' 9...equipment
Dim myArray(500, 10)
Private Sub getValues(position)
'guarantee that one cannot move upper first line
Dim firstLine
firstLine = Sheets("Ablauf").Range("zero").row + 1
If position < firstLine Then position = firstLine
'activate whole line of current position
Cells(position, 1).Activate
activeCell.EntireRow.Select
'select according values of dependency-comboboxes
'cbDependency1.s... !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Add values to textboxes
cbEquipment.Text = Cells(position, Range("equipment").Column)
cbMovement.Text = Cells(position, Range("movement").Column)
tbSpeed.Text = Cells(position, Range("speed").Column)
tbDistance.Text = Cells(position, Range("distance").Column)
tbDuration.Text = Cells(position, Range("duration").Column)
Select Case Cells(position, Range("type").Column).Text
Case ""
cbType.ListIndex = 0
Case "H"
cbType.ListIndex = 1
Case "E"
cbType.ListIndex = 2
Case "A"
cbType.ListIndex = 3
End Select
tbFlow.Text = Cells(position, Range("flow").Column).Text
'set the timings
s1.value = Cells(position, Range("start1").Column).value
e1.value = Cells(position, Range("end1").Column).value
'd1.value = Cells(position, Range("duration1").Column).value
s2.value = Cells(position, Range("start2").Column).value
e2.value = Cells(position, Range("end2").Column).value
'd2.value = Cells(position, Range("duration2").Column).value
s3.value = Cells(position, Range("start3").Column).value
e3.value = Cells(position, Range("end3").Column).value
'd3.value = Cells(position, Range("duration3").Column).value
s4.value = Cells(position, Range("start4").Column).value
e4.value = Cells(position, Range("end4").Column).value
'd4.value = Cells(position, Range("duration4").Column).value
s5.value = Cells(position, Range("start5").Column).value
e5.value = Cells(position, Range("end5").Column).value
'd5.value = Cells(position, Range("duration5").Column).value
s6.value = Cells(position, Range("start6").Column).value
e6.value = Cells(position, Range("end6").Column).value
'd6.value = Cells(position, Range("duration6").Column).value
s7.value = Cells(position, Range("start7").Column).value
e7.value = Cells(position, Range("end7").Column).value
'd7.value = Cells(position, Range("duration7").Column).value
s8.value = Cells(position, Range("start8").Column).value
e8.value = Cells(position, Range("end8").Column).value
'd8.value = Cells(position, Range("duration8").Column).value
End Sub
'delete values of all fields of the form
Private Sub resetFields()
cbEquipment.ListIndex = -1
cbMovement.ListIndex = -1
cbDependency1.ListIndex = -1
cbDependency2.ListIndex = -1
cbDependency3.ListIndex = -1
cbDependency4.ListIndex = -1
cbDependency5.ListIndex = -1
tbSpeed.value = ""
tbDuration.value = ""
tbDistance.value = ""
cbType.ListIndex = -1
tbFlow.value = ""
s1.value = ""
e1.value = ""
'd1.value = ""
s2.value = ""
e2.value = ""
'd2.value = ""
s3.value = ""
e3.value = ""
'd3.value = ""
s4.value = ""
e4.value = ""
'd4.value = ""
s5.value = ""
e5.value = ""
'd5.value = ""
s6.value = ""
e6.value = ""
'd6.value = ""
s7.value = ""
e7.value = ""
'd7.value = ""
s8.value = ""
e8.value = ""
'd8.value = ""
End Sub
'updates the line indices in column A
Private Sub updateIndices()
Dim startRow, endRow, i, col
startRow = Range("no").row + 2
endRow = Range("tail").row - 1
col = Range("tail").Column
For i = 1 To (endRow - startRow) + 1
Cells(startRow + i - 1, col) = i
Next i
End Sub
Private Sub insertValues()
'insert movement/dependency names into worksheet
Cells(activeCell.row, Range("equipment").Column) = cbEquipment.value
Cells(activeCell.row, Range("movement").Column) = cbMovement.value
If cbDependency1.ListIndex <> -1 Then Cells(activeCell.row, Range("dependency1").Column) = cbDependency1.value
If cbDependency2.ListIndex <> -1 Then Cells(activeCell.row, Range("dependency2").Column) = cbDependency2.value
If cbDependency3.ListIndex <> -1 Then Cells(activeCell.row, Range("dependency3").Column) = cbDependency3.value
If cbDependency4.ListIndex <> -1 Then Cells(activeCell.row, Range("dependency4").Column) = cbDependency4.value
If cbDependency5.ListIndex <> -1 Then Cells(activeCell.row, Range("dependency5").Column) = cbDependency5.value
'insert data into worksheet
If (tbSpeed.value <> "") Then Cells(activeCell.row, Range("speed").Column) = CDbl(tbSpeed.value)
If (tbDistance.value <> "") Then Cells(activeCell.row, Range("distance").Column).value = CDbl(tbDistance.value)
If (tbDuration.value <> "") Then Cells(activeCell.row, Range("duration").Column).value = CDbl(tbDuration.value)
Select Case cbType.ListIndex
Case 0
Cells(activeCell.row, Range("type").Column) = ""
Case 1
Cells(activeCell.row, Range("type").Column) = "H"
Case 2
Cells(activeCell.row, Range("type").Column) = "E"
Case 3
Cells(activeCell.row, Range("type").Column) = "A"
End Select
If (tbFlow.value <> "") Then Cells(activeCell.row, Range("flow").Column).value = CDbl(tbFlow.value)
'insert timings into worksheet
If (s1.value <> "") Then Cells(activeCell.row, Range("start1").Column) = CInt(s1.value)
If (e1.value <> "") Then Cells(activeCell.row, Range("end1").Column) = CInt(e1.value)
'If (d1.value <> "") Then Cells(activeCell.row, Range("duration1").Column) = CInt(d1.value)
'If (s2 <> "" And e1 <> "") Then Cells(activeCell.Row, Range("break12").Column) = CInt(s2 - e1
If (s2.value <> "") Then Cells(activeCell.row, Range("start2").Column) = CInt(s2.value)
If (e2.value <> "") Then Cells(activeCell.row, Range("end2").Column) = CInt(e2.value)
'If (d2.value <> "") Then Cells(activeCell.row, Range("duration2").Column) = CInt(d2.value)
'If (s3 <> "" And e2 <> "") Then Cells(activeCell.Row, Range("break23").Column) = CInt(s3 - d2
If (s3.value <> "") Then Cells(activeCell.row, Range("start3").Column) = CInt(s3.value)
If (e3.value <> "") Then Cells(activeCell.row, Range("end3").Column) = CInt(e3.value)
'If (d3.value <> "") Then Cells(activeCell.row, Range("duration3").Column) = CInt(d3.value)
'If (s4 <> "" And e3 <> "") Then Cells(activeCell.Row, Range("break34").Column) = CInt(s4 - e3
If (s4.value <> "") Then Cells(activeCell.row, Range("start4").Column) = CInt(s4.value)
If (e4.value <> "") Then Cells(activeCell.row, Range("end4").Column) = CInt(e4.value)
'If (d4.value <> "") Then Cells(activeCell.row, Range("duration4").Column) = CInt(d4.value)
'If (s5 <> "" And e4 <> "") Then Cells(activeCell.Row, Range("break45").Column) = CInt(s5 - e4
If (s5.value <> "") Then Cells(activeCell.row, Range("start5").Column) = CInt(s5.value)
If (e5.value <> "") Then Cells(activeCell.row, Range("end5").Column) = CInt(e5.value)
'If (d5.value <> "") Then Cells(activeCell.row, Range("duration5").Column) = CInt(d5.value)
'If (s6 <> "" And e5 <> "") Then Cells(activeCell.Row, Range("break56").Column) = CInt(s6 - e4
If (s6.value <> "") Then Cells(activeCell.row, Range("start6").Column) = CInt(s6.value)
If (e6.value <> "") Then Cells(activeCell.row, Range("end6").Column) = CInt(e6.value)
'If (d6.value <> "") Then Cells(activeCell.row, Range("duration6").Column) = CInt(d6.value)
'If (s7 <> "" And e6 <> "") Then Cells(activeCell.Row, Range("break67").Column) = CInt(s7 - e6
If (s7.value <> "") Then Cells(activeCell.row, Range("start7").Column) = CInt(s7.value)
If (e7.value <> "") Then Cells(activeCell.row, Range("end7").Column) = CInt(e7.value)
'If (d7.value <> "") Then Cells(activeCell.row, Range("duration7").Column) = CInt(d7.value)
'If (s8 <> "" And e7 <> "") Then Cells(activeCell.Row, Range("break78").Column) = CInt(s8 - e7
If (s8.value <> "") Then Cells(activeCell.row, Range("start8").Column) = CInt(s8.value)
If (e8.value <> "") Then Cells(activeCell.row, Range("end8").Column) = CInt(e8.value)
'If (d8.value <> "") Then Cells(activeCell.row, Range("duration8").Column) = CInt(d8.value)
End Sub
Private Sub bDeleteRow_Click()
If activeCell.row >= Range("tail").row Then Exit Sub
Dim msg
msg = MsgBox("Delete Row?", vbYesNo, "Warning")
If msg = 6 Then 'yes is selected
Call resetFields
activeCell.EntireRow.Delete
End If
If activeCell.row >= Range("tail").row Then bBack_Click
Call updateIndices
End Sub
Private Sub bGraph1_Click()
scrollFormV.Enabled = False
scrollFormH.Enabled = False
bNewLine.Enabled = False
bDeleteRow.Enabled = False
bCancel.Enabled = False
bExit.Enabled = False
bCalculate.Enabled = False
bBack.Enabled = False
bBack10.Enabled = False
bForward.Enabled = False
bForward10.Enabled = False
bHelp.Enabled = False
Sheets("Ablauf (Chart)").Activate
End Sub
Private Sub bGraph2_Click()
scrollFormV.Enabled = False
scrollFormH.Enabled = False
bNewLine.Enabled = False
bDeleteRow.Enabled = False
bCancel.Enabled = False
bExit.Enabled = False
bCalculate.Enabled = False
bBack.Enabled = False
bBack10.Enabled = False
bForward.Enabled = False
bForward10.Enabled = False
bHelp.Enabled = False
Sheets("Verbrauch (Chart)").Activate
End Sub
Private Sub bAblauf_Click()
scrollFormV.Enabled = True
scrollFormH.Enabled = True
bNewLine.Enabled = True
bDeleteRow.Enabled = True
bCancel.Enabled = True
bExit.Enabled = True
bCalculate.Enabled = True
bBack.Enabled = True
bBack10.Enabled = True
bForward.Enabled = True
bForward10.Enabled = True
bHelp.Enabled = True
Sheets("Ablauf").Activate
End Sub
Private Sub bHelp_Click()
'open Help-File
Dim msg
msg = MsgBox("The 'Help' is under construction!", vbOKOnly, "Availability")
End Sub
Private Sub bNewLine_Click()
Dim row
row = activeCell.row
'if we are in the first line of data...
If row = Range("no").row + 2 Then
'...create the row one row deeper and copy the contents of the upper row (reason: formatting)
Selection.Copy
Cells(row + 1, Range("no").Column).Select
activeCell.EntireRow.Insert
Selection.PasteSpecial
Cells(row, Range("no").Column).Select
activeCell.EntireRow.Select
Selection.ClearContents
Else
activeCell.EntireRow.Insert
activeCell.EntireRow.Select
End If
Call resetFields
Call updateIndices
End Sub
Private Sub bCancel_Click()
Unload fAblauf
End Sub
Private Sub bExit_Click()
Dim msg
msg = MsgBox("Insert values into list and exit?", vbYesNoCancel, "Insert values & Exit")
If msg = 6 Then 'yes is selected
Call insertValues
Unload fAblauf
ElseIf msg = 7 Then 'no is selected
Unload fAblauf
End If
End Sub
Private Sub bBack_Click()
If (activeCell.row > Range("no").row + 2) Then
insertValues
getValues (activeCell.row - 1)
End If
End Sub
Private Sub bForward_Click()
'if last row is reached, insert new line at the end of the list
If (activeCell.row = Range("tail").row - 1) Then
activeCell.EntireRow.Insert
insertValues
Cells(activeCell.row + 1, Range("no").Column).Select
activeCell.EntireRow.Select
Selection.ClearContents
Call updateIndices
getValues (activeCell.row)
cbDependency1.AddItem (Cells(activeCell.row, Range("no").Column).value)
cbDependency2.AddItem (Cells(activeCell.row, Range("no").Column).value)
cbDependency3.AddItem (Cells(activeCell.row, Range("no").Column).value)
cbDependency4.AddItem (Cells(activeCell.row, Range("no").Column).value)
cbDependency5.AddItem (Cells(activeCell.row, Range("no").Column).value)
'else just get the values of the next line
Else
insertValues
getValues (activeCell.row + 1)
End If
End Sub
Private Sub bBack10_Click()
insertValues
If (activeCell.row - 10 < Range("no").row + 2) Then
getValues (Range("no").row + 2)
Else
getValues (activeCell.row - 10)
End If
End Sub
Private Sub bForward10_Click()
insertValues
If (activeCell.row + 10 >= Range("tail").row) Then
getValues (Range("tail").row - 1)
Else
getValues (activeCell.row + 10)
End If
End Sub
Private Sub cbMovement_onExit()
'hier muß rausgesprungen werden, wenn die aktuelle Bewegung nicht aus dem Array ist, sondern etwa
'eingegeben wurde UND wenn die Bewegung aus dem Array ist, muß in der Liste cbMovement die richtige
'Position eingestellt/selektiert werden!!!!
'movement not in list or new entered
If cbMovement.ListIndex < 0 Then Exit Sub
'cbEquipment.value = ""
'cbEquipment.ListIndex = -1
Dim pos
pos = cbMovement.ListIndex
tbSpeed.value = myArray(pos, 2)
tbDuration.value = myArray(pos, 3)
tbFlow.value = myArray(pos, 4)
cbType.ListIndex = 0
s1.value = ""
'd1.value = ""
e1.value = ""
s2.value = ""
'd2.value = ""
e2.value = ""
s3.value = ""
'd3.value = ""
e3.value = ""
s4.value = ""
'd4.value = ""
e4.value = ""
s5.value = ""
'd5.value = ""
e5.value = ""
s6.value = ""
'd6.value = ""
e6.value = ""
s7.value = ""
'd7.value = ""
e7.value = ""
s8.value = ""
'd8.value = ""
e8.value = ""
End Sub
Private Sub bCalculate_Click()
Call berechneVerbrauch
Sheets("Ablauf").Activate
End Sub
Private Sub cbEquipment_Change()
'enter all movements of the equipment (see cylinder list) into the movement combobox
cbMovement.Clear
Dim i
For i = 0 To 499
If myArray(i, 9) = cbEquipment.value Then cbMovement.AddItem (myArray(i, 0) & " - " & myArray(i, 1))
Next i
End Sub
Private Sub cbMovement_Change()
If cbMovement.ListIndex <> -1 Then
'search for values in myArray
Dim i, arrLen
arrLen = myArray.Length()
For i = 0 To arrLen - 1
If (myArray(i, 9) = cbEquipment.value And myArray(i, 0) = cbMovement.value) Then
'get values and insert them into the textboxes
MsgBox ("test ok")
Exit Sub
End If
Next i
End If
End Sub
Private Sub scrollFormV_Change()
Application.ActiveWindow.ScrollRow = Range("no").row + 1 + scrollFormV.value
End Sub
Private Sub scrollFormH_Change()
Application.ActiveWindow.ScrollColumn = scrollFormH.value
End Sub
Private Sub tbBLZ_Change()
Range("blz").value = tbBLZ.value
End Sub
Private Sub tbSpeed_Change()
If (tbSpeed.value = "") Then Exit Sub
If (tbDistance.value <> "") Then
tbDuration.value = tbDistance.value / tbSpeed.value
End If
End Sub
Private Sub tbDistance_Change()
If tbDistance.value = "" Then Exit Sub
If (tbSpeed.value <> "") Then
tbDuration.value = tbDistance.value / tbSpeed.value
Exit Sub
End If
End Sub
Private Sub tbDuration_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'if time is entered, distance and speed are not interesting any longer
tbSpeed.value = ""
tbDistance.value = ""
End Sub
Public Sub UserForm_Initialize()
'if current line does not contain any values (out of range) set activeCell to first line
If (activeCell.row < Range("no").row + 2) Then
Cells(Range("no").row + 2, Range("no").Column).Select
ElseIf (activeCell.row > Range("tail").row - 1) Then
Cells(Range("tail").row - 1, Range("no").Column).Select
End If
' ##############################################################################################
' Start Array Setup with values of Hydraulic-List
' emptyCells dient dazu, festzustellen, wo die Liste aufhört (bei ? leeren Zeilen stoppt loop)
' myArray(500, 10) has already been defined as global
Dim k, l
'inizialisiere Array-Felder mit Wert 0
For k = 0 To 499
For l = 0 To 9
myArray(k, l) = 0
Next l
Next k
Dim arrPos
arrPos = 0 'Positionsanzeiger der aktuellen Zeile im Array
Dim emptyCells, i
Dim actCell, actEquipment
emptyCells = 0
i = Sheets("Hydraulic Cylinder").Range("machine").row + 1
Do
actCell = Worksheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("machine").Column)
If (IsEmpty(actCell)) Then
emptyCells = emptyCells + 1
Else
emptyCells = 0
'alt: If (Cells(i, Range("machine").Column).Font.Bold = True) Then
If (Worksheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("machine").Column).Font.Bold = False) Then
'************ ARRAY auffüllen *****************'
'Movement 1 of machine
myArray(arrPos, 0) = actCell
myArray(arrPos, 1) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("fundes").Column)
myArray(arrPos, 2) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("value8").Column) 'speed
myArray(arrPos, 3) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("ta").Column) 'time to go
myArray(arrPos, 4) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("qak").Column) 'oil waste
myArray(arrPos, 5) = i
myArray(arrPos, 6) = 1 'for movement (sol) 1
myArray(arrPos, 9) = actEquipment
arrPos = arrPos + 1
'Movement 2 of machine
myArray(arrPos, 0) = actCell
myArray(arrPos, 1) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("fundes2").Column)
myArray(arrPos, 2) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("value9").Column) 'speed
myArray(arrPos, 3) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("te").Column) 'time to go
myArray(arrPos, 4) = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("qes").Column) 'oil waste
myArray(arrPos, 5) = i
myArray(arrPos, 6) = 2 'für movement (sol) 2
myArray(arrPos, 9) = actEquipment
arrPos = arrPos + 1
'**********************************************'
Else 'means that font is bold and found item is an equipment
actEquipment = Sheets("Hydraulic Cylinder").Cells(i, Sheets("Hydraulic Cylinder").Range("machine").Column)
cbEquipment.AddItem (actEquipment)
'do same with other lists (pneumatic, etc.)
End If
End If
i = i + 1
Loop Until emptyCells > 10
' Array Setup finished
' ##############################################################################################
'Add possible settings for Type-ComboBox
cbType.AddItem ("n/a")
cbType.AddItem ("H - hydraulic")
cbType.AddItem ("E - electrical")
cbType.AddItem ("A - aero")
'get BLZ Time
tbBLZ.value = Range("blz").value
'set scrollbar values
scrollFormV.max = Cells(Range("tail").row - 1, Range("no").Column)
scrollFormH.max = Range("horizon").Column
'Fill Dependency-ComboBoxes with values from sheet "Ablauf"
cbDependency1.Clear
cbDependency2.Clear
cbDependency3.Clear
cbDependency4.Clear
cbDependency5.Clear
Dim i6
For i6 = Range("no").row + 2 To Range("tail").row - 1
cbDependency1.AddItem (Cells(i6, Range("no").Column) & " - " & Cells(i6, Range("movement").Column))
cbDependency2.AddItem (Cells(i6, Range("no").Column) & " - " & Cells(i6, Range("movement").Column))
cbDependency3.AddItem (Cells(i6, Range("no").Column) & " - " & Cells(i6, Range("movement").Column))
cbDependency4.AddItem (Cells(i6, Range("no").Column) & " - " & Cells(i6, Range("movement").Column))
cbDependency5.AddItem (Cells(i6, Range("no").Column) & " - " & Cells(i6, Range("movement").Column))
Next i6
'get values from the current row (where activecell is)
getValues (activeCell.row)
End Sub