[Arsie]

Дык там по кнопке. Непрерывно. Есть только ограничение на количество "непрерывности".

Таблица заполняется по нажатию кнопки, в свойствах кнопки указан выполняющийся макрос. Он вызывает функцию FillTable. Она страшна на вид только из-за того, что фиксирует ошибки передачи и выводит их на экран. Плюс обеспечивает синхронизацию между переменными, т.к. одна строка состоит из нескольких переменных.

Суть функции в тупом копировании нескольких ячеек в таблицу с изменением номера строки. Т.е. построение "текстового тренда". Данные меняются в исходных ячейках самостоятельно.


Private Sub FillTable()

Dim f As Integer
Dim TimeOut As Integer
Dim PauseTime, Start

TimeOut = 0

Worksheets("Àâàðèè").Cells(6, 3).Value = Worksheets("Àâàðèè").Cells(110, 3).Value

' î÷èñòêà òàáëèöû æóðíàëà
ClearTable (99)

Worksheets("Àâàðèè").Cells(6, 3).Value = Worksheets("Àâàðèè").Cells(111, 3).Value

f = 0
If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver

mychannelwr = DDEInitiate("SERVOPC", "Request3")

Set wr = Worksheets("Àâàðèè").Cells(50 + 6, 2)
If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver
Call DDEPoke(mychannelwr, "ARC_IN0", wr)
PauseTime = 5
Start = Timer ' Set start time.
Do While Timer < (Start + PauseTime)
DoEvents ' Yield to other processes.
Loop

For f = 0 To Worksheets("Àâàðèè").Range("H11").Value - 1

Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(114, 3).Value
If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver

Set wr = Worksheets("Àâàðèè").Cells(f + 6, 2)

CB1Cloop:

DoEvents
If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver
Call DDEPoke(mychannelwr, "ARC_IN0", wr)
DoEvents

PauseTime = 1
Start = Timer ' Set start time.
Do While Timer < (Start + PauseTime)
DoEvents ' Yield to other processes.
Loop

TimeOut = TimeOut + 1

If (TimeOut > 30) Then Exit For

If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver

If (Worksheets("Àâàðèè").Range("H8").Value <> 1) Then GoTo CB1Cloop
If (Worksheets("Àâàðèè").Range("H10").Value <> 1) Then GoTo CB1Cloop
If (Worksheets("Àâàðèè").Range("G6").Value <> Worksheets("Àâàðèè").Cells(f + 6, 2).Value) Then GoTo CB1Cloop
TimeOut = 0
If (Worksheets("Àâàðèè").Range("G8").Value = 0) Then Exit For

Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(109, 3).Value

'ïðîâåðêà íà äîïóñòèìîñòü äàííûõ
If (Worksheets("Àâàðèè").Range("G8").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G8").Value > 40) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G9").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G9").Value > 3000) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G10").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G10").Value > 3000) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G11").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G11").Value > 3000) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G12").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G12").Value > 3000) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G13").Value < 0) Then GoTo SkipWrite
If (Worksheets("Àâàðèè").Range("G13").Value > 3000) Then GoTo SkipWrite

Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(Worksheets("Àâàðèè").Ra nge("G8").Value + 120, 3).Value
Worksheets("Àâàðèè").Cells(f + 6, 4).Value = TimeSerial(Worksheets("Àâàðèè").Range("G9").Value, Worksheets("Àâàðèè").Range("G10").Value, 0)
Worksheets("Àâàðèè").Cells(f + 6, 5).Value = DateSerial(Worksheets("Àâàðèè").Range("G13").Value , Worksheets("Àâàðèè").Range("G12").Value, Worksheets("Àâàðèè").Range("G11").Value)

SkipWrite:

Next f

Worksheets("Àâàðèè").Cells(9, 8).Value = f 'çàïîìèíàåì äîêóäà çàïîëíåíî

If (Worksheets("Àâàðèè").Range("G24").Value = CBool(1)) Then GoTo norespons
If (Worksheets("Àâàðèè").Range("H24").Value = CBool(1)) Then GoTo noserver
DDETerminate mychannelwr

If (TimeOut > 30) Then Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(112, 3).Value
If (TimeOut < 30) Then Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(113, 3).Value

GoTo endsub

norespons:

Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(115, 3).Value
GoTo endsub

noserver:

Worksheets("Àâàðèè").Cells(f + 6, 3).Value = Worksheets("Àâàðèè").Cells(116, 3).Value

endsub:

End Sub