Option Explicit
Dim StrCellTrueFalse As String
Dim IntCounter As Integer
Dim IntCounterBU As Integer
Dim IntCounterO As Integer
Dim IntCounterP As Integer
Dim StrWholeValue As String
Dim StrBU As String
Dim StrO As String
Dim StrLineP As String
Dim IntValA As Integer
Dim IntValB As Integer
Dim IntValC As Integer
Dim Answer As String
Dim AnswerDef As String
Dim P1 As Integer
Dim NeuData As DataObject
Private Sub CommandButton1_Click()
StrWholeValue = ""
StrBU = ""
StrO = ""
StrLineP = ""
Answer = ""
AnswerDef = ""
IntCounter = 4
IntCounterBU = 4
IntCounterO = 4
IntCounterP = 4
Do Until IntCounter = 10000
StrWholeValue = Range("U" & IntCounter).Value
StrBU = Range("R" & IntCounterBU).Value
StrO = Range("O" & IntCounterO).Value
If StrWholeValue = "" Then
IntCounter = IntCounter + 1
IntCounterBU = IntCounterBU + 1
IntCounterO = IntCounterO + 1
IntCounterP = IntCounterP + 1
Else
P1 = Application.Find("-", StrBU, 1)
IntValA = Left(StrBU, P1 - 1)
IntValB = Mid(StrBU, P1 + 1)
IntValC = IntValB - IntValA + 1
If StrWholeValue = "B" Or StrWholeValue = "b" Then
Answer = "pstnBlockActivateTrunk" & " " & Chr(34) & StrO & Chr(34) & " " & "-1 " & IntValA & " " & IntValB & " 2" & Chr(13) & "sleep 1000"
AnswerDef = AnswerDef & Chr(13) & Answer
Else
If StrWholeValue = "U" Or StrWholeValue = "u" Then
StrLineP = Range("P" & IntCounterP).Value
Answer = "pstnBlockActivateTrunk " & " " & Chr(34) & StrO & Chr(34) & " " & "-1 " & IntValA & " " & IntValB & " 1" & Chr(13) & "isupResetCircuit" & " " & StrLineP & " " & IntValB & " " & IntValC & Chr(13) & "sleep 1000"
AnswerDef = AnswerDef & Chr(13) & Answer
End If
End If
IntCounter = IntCounter + 1
IntCounterBU = IntCounter + 1
IntCounterO = IntCounter + 1
IntCounterP = IntCounterP + 1
End If
Loop
If AnswerDef = "" Then
MsgBox ("Keine Einträge vorhanden!")
Else
Set NeuData = New DataObject
NeuData.SetText AnswerDef
NeuData.PutInClipboard
End If
End Sub |